RESOLU - Excel VBA - Données, Dico, et MsgBox

Dernière réponse : 17 Mai 2011 14:04 dans Programmation

Guillaume831

17 Mai 2011 11:07:04

Bonjour à tous,

Je suis actuellement en train de travailler sur la construction d’un emploi du temps intelligent et multifonctionnel. En tant qu’étudiant, j’en profite du coup pour me former au VBA sur Excel.

Afin de mieux comprendre la situation, je vais décrire mon fichier. J’ai deux premiers onglets administratifs, qui comportent des paramètres bateaux pour excel, dont un tableauA, dont chaque ligne comprend le nom d’un prof, une heure de debut, de fin, et un cours. Ces informations sont ensuite répercutées dans l’onglet qui lui est destiné sous une autre forme. Ce tableauA est appelé à compter plusieurs lignes, et ce qui m’intéresse désormais maintenant, c’est de créer une macro qui me permettraient de connaître quel prof serait dispos avec les critères établis. Je vous laisse lire le code ci-dessous.

Mais mon code ne marche pas, et je désespère un peu là…

Je me suis permis de publier ce post sur plusieurs forums. Ne vous en sentez pas offusqués, c’est juste pour pouvoir étudier les différents réponses qui me seraient proposées.

Cordialement,

Guillaume

Option Explicit

 
Sub QuiEstDispo()

 
Dim ValeurRecherche, RangePlage

Dim Jour As String, Debut As String, Fin As String

Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer

Dim NomdeProf As Range

 
With Application

    .ScreenUpdating = False

    .Calculation = xlCalculationManual

End With

 
Set DicoProfs = CreateObject("Scripting.Dictionary")

 
Jour = InputBox("Ecrivez un jour : Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi", "Quel jour vous intéresse?") 'définit le jour intéressant

 
Select Case Jour

    Case "Lundi": Colonne = 3

    Case "Mardi": Colonne = 4

    Case "Mercredi": Colonne = 5

    Case "Jeudi": Colonne = 6

    Case "Vendredi": Colonne = 7

    Case "Samedi": Colonne = 8

    Case Else

        MsgBox "Veuillez indiquer un jour de la semaine correct!"

        Exit Sub

End Select

 
Debut = InputBox("De quelle heure? - Format : XX:XX:XX ") 'définit le début de la plage horaire

 
Select Case Debut

    Case "08:00:00": RangeeD = 4

    Case "08:30:00": RangeeD = 5

    Case "09:00:00": RangeeD = 6

    Case "09:30:00": RangeeD = 7

    Case "10:00:00": RangeeD = 8

    Case "10:30:00": RangeeD = 9

    Case "11:00:00": RangeeD = 10

    Case "11:30:00": RangeeD = 11

    Case "12:00:00": RangeeD = 12

    Case "12:30:00": RangeeD = 13

    Case "13:00:00": RangeeD = 14

    Case "13:30:00": RangeeD = 15

    Case "14:00:00": RangeeD = 16

    Case "14:30:00": RangeeD = 17

    Case "15:00:00": RangeeD = 18

    Case "15:30:00": RangeeD = 19

    Case "16:00:00": RangeeD = 20

    Case "16:30:00": RangeeD = 21

    Case "17:00:00": RangeeD = 22

    Case "17:30:00": RangeeD = 23

    Case "18:00:00": RangeeD = 24

Case Else

        MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "

        Exit Sub

End Select

 
Fin = InputBox("Jusqu'à quelle heure? - Format : XX:XX:XX ") 'définit la fin de la plage horaire

Select Case Fin

    Case "08:00:00": RangeeF = 4

    Case "08:30:00": RangeeF = 5

    Case "09:00:00": RangeeF = 6

    Case "09:30:00": RangeeF = 7

    Case "10:00:00": RangeeF = 8

    Case "10:30:00": RangeeF = 9

    Case "11:00:00": RangeeF = 10

    Case "11:30:00": RangeeF = 11

    Case "12:00:00": RangeeF = 12

    Case "12:30:00": RangeeF = 13

    Case "13:00:00": RangeeF = 14

    Case "13:30:00": RangeeF = 15

    Case "14:00:00": RangeeF = 16

    Case "14:30:00": RangeeF = 17

    Case "15:00:00": RangeeF = 18

    Case "15:30:00": RangeeF = 19

    Case "16:00:00": RangeeF = 20

    Case "16:30:00": RangeeF = 21

    Case "17:00:00": RangeeF = 22

    Case "17:30:00": RangeeF = 23

    Case "18:00:00": RangeeF = 24

Case Else

        MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "

        Exit Sub

End Select

 
RangePlage = Range(Cells(RangeeD, Colonne), Cells(RangeeF, Colonne)).Address 'est censée représenter la plage horaire du jour défini pour l'analyse ci-dessous

 
' dans ce qui suit, je cherche à sélectionner les profs suivants ces critères:

'  - en respectant la rangeplage : plage horaire choisie, selon le jour qui convient

'  - en ignorant les cases qui sont coloriées. Elles signifient que le professeur s'est mis en indisponibilités à ce moment là.

'  - en ignorant les cases qui sont déjà pleines, car s'ils ont déjà un cours, ils ne sont pas dispos pour un nouveau cours!

'  - si les critères ci-dessus sont respectés, alors la macro enregistre le nom du prof, en E1 sur chaque onglet de prof, et me l'enregistre dans DicoProfs

'alors, ma MsgBox me donne au final la liste des profs répondant à tous les critères ci-dessus

 
For Each ValeurRecherche In Range(RangePlage)

    If Not DicoProfs.Exists(Cells(1, 5).Value) And

        With ValeurRecherche

        .Value = ""

        .Selection.Interior.Pattern = xlNone

        End With

    Then DicoProfs.Add Cells(1, 5).Value, Cells(1, 5).Value

    End If

Next ValeurRecherche

 
MsgBox (Application.Transpose(DicoProfs.Items))

 
End Sub

Autres pages sur : resolu excel vba donnees dico msgbox

| Etre averti des réponses
| Alerter

Répondre à Guillaume831

Lassé par la pub ? Créez un compte

Meilleure solution

Guillaume831

17 Mai 2011 13:06:59

Les gars, je vous remercie de votre temps... On vient de me filer ça sur un autre forum, je le partage avec vous!

BOnne analyse!

Option Explicit

 
 
 
Sub QuiEstDispo()

 
Dim ValeurRecherche, RangePlage

Dim Jour As String, Debut As String, Fin As String

Dim Colonne As Integer, RangeeD As Integer, RangeeF As Integer

Dim NomdeProf As Range

Dim dicoprofs As Object

Dim curSheet As Worksheet

Dim curligne As Integer

Dim result() As String

Dim BreakBoucle As Boolean

Dim I As Integer

Dim reponse As String

 
With Application

    .ScreenUpdating = False

    .Calculation = xlCalculationManual

End With

 
Set dicoprofs = CreateObject("Scripting.Dictionary")

 
Jour = InputBox("Ecrivez un jour : Lundi, Mardi, Mercredi, Jeudi, Vendredi, Samedi", "Quel jour vous intéresse?") 'définit le jour intéressant

 
Select Case Jour

    Case "Lundi", "lundi": Colonne = 3

    Case "Mardi", "mardi": Colonne = 4

    Case "Mercredi", "mercredi": Colonne = 5

    Case "Jeudi", "jeudi": Colonne = 6

    Case "Vendredi", "vendredi": Colonne = 7

    Case "Samedi", "samedi": Colonne = 8

    Case Else

        MsgBox "Veuillez indiquer un jour de la semaine correct!"

        Exit Sub

End Select

 
Debut = InputBox("De quelle heure? - Format : XX:XX ") 'définit le début de la plage horaire

 
Select Case Debut

    Case "08:00": RangeeD = 4

    Case "08:30": RangeeD = 5

    Case "09:00": RangeeD = 6

    Case "09:30": RangeeD = 7

    Case "10:00": RangeeD = 8

    Case "10:30": RangeeD = 9

    Case "11:00": RangeeD = 10

    Case "11:30": RangeeD = 11

    Case "12:00": RangeeD = 12

    Case "12:30": RangeeD = 13

    Case "13:00": RangeeD = 14

    Case "13:30": RangeeD = 15

    Case "14:00": RangeeD = 16

    Case "14:30": RangeeD = 17

    Case "15:00": RangeeD = 18

    Case "15:30": RangeeD = 19

    Case "16:00": RangeeD = 20

    Case "16:30": RangeeD = 21

    Case "17:00": RangeeD = 22

    Case "17:30": RangeeD = 23

    Case "18:00": RangeeD = 24

Case Else

        MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "

        Exit Sub

End Select

 
Fin = InputBox("Jusqu'à quelle heure? - Format : XX:XX ") 'définit la fin de la plage horaire

Select Case Fin

    Case "08:00": RangeeF = 4

    Case "08:30": RangeeF = 5

    Case "09:00": RangeeF = 6

    Case "09:30": RangeeF = 7

    Case "10:00": RangeeF = 8

    Case "10:30": RangeeF = 9

    Case "11:00": RangeeF = 10

    Case "11:30": RangeeF = 11

    Case "12:00": RangeeF = 12

    Case "12:30": RangeeF = 13

    Case "13:00": RangeeF = 14

    Case "13:30": RangeeF = 15

    Case "14:00": RangeeF = 16

    Case "14:30": RangeeF = 17

    Case "15:00": RangeeF = 18

    Case "15:30": RangeeF = 19

    Case "16:00": RangeeF = 20

    Case "16:30": RangeeF = 21

    Case "17:00": RangeeF = 22

    Case "17:30": RangeeF = 23

    Case "18:00": RangeeF = 24

Case Else

        MsgBox "Veuillez indiquer un horaire correct! - Format : XX:XX:XX "

        Exit Sub

End Select

 
' RangePlage = Range(Cells(RangeeD, Colonne), Cells(RangeeF, Colonne)).Address 'est censée représenter la plage horaire du jour défini pour l'analyse ci-dessous

 
' dans ce qui suit, je cherche à sélectionner les profs suivants ces critères:

'  - en respectant la rangeplage : plage horaire choisie, selon le jour qui convient

'  - en ignorant les cases qui sont coloriées. Elles signifient que le professeur s'est mis en indisponibilités à ce moment là.

'  - en ignorant les cases qui sont déjà pleines, car s'ils ont déjà un cours, ils ne sont pas dispos pour un nouveau cours!

'  - si les critères ci-dessus sont respectés, alors la macro enregistre le nom du prof, en E1 sur chaque onglet de prof, et me l'enregistre dans DicoProfs

'alors, ma MsgBox me donne au final la liste des profs répondant à tous les critères ci-dessus

ReDim result(0)

result(0) = ""

For Each curSheet In Sheets

    If curSheet.Name <> "Administratif" And curSheet.Name <> "Cours" Then

        curSheet.Activate

        BreakBoucle = False

        For curligne = RangeeD To RangeeF

            If GetValue(translateCoord(curligne, Colonne)) = "" Then

                If Selection.Interior.Pattern <> xlNone Then

                    BreakBoucle = True

                    Exit For

                End If

            Else

                BreakBoucle = True

                Exit For

            End If

        Next curligne

        If Not BreakBoucle Then

            result(UBound(result)) = GetValue(translateCoord(1, 5))

            ReDim Preserve result(UBound(result) + 1)

        End If

    End If

Next

If UBound(result) > 0 Then ReDim Preserve result(UBound(result) - 1)

Sheets("Cours").Activate

If result(0) <> "" Then

    reponse = "liste des personnes dispo:"

    For I = 0 To UBound(result)

        reponse = reponse + vbCrLf + result(I)

    Next I

    MsgBox (reponse)

Else

    MsgBox "personne de dispo"

End If

End Sub

 
Private Function translateCoord(NumLine As Integer, NumCol As Integer) As String

    translateCoord = TranslateNumColIntoChar(NumCol) & Trim(Str(NumLine))

End Function

Private Function TranslateNumColIntoChar(NumCol As Integer) As String

Dim Reste As Long

 
    If NumCol <= 26 Then

        TranslateNumColIntoChar = Chr(Asc("A") + NumCol - 1)

    Else

        Reste = (NumCol - 1) Mod 26

        TranslateNumColIntoChar = Chr(Asc("A") + Int((NumCol - 1) / 26) - 1) & Chr(Asc("A") + Reste)

    End If

End Function

Private Function GetValue(cellule As String) As Variant

    Range(cellule).Select

    GetValue = ActiveCell.Value

End Function

| Alerter

Répondre à Guillaume831

zeb

Expert Programmation

17 Mai 2011 14:03:56

(Pas eu le temps de regarder. Mais ton code est trop long ! Factorise tout ça, pour le bien de ta macro.)

| Alerter

Répondre à zeb

zeb

Expert Programmation

17 Mai 2011 14:04:09

Meilleure réponse sélectionnée par zeb.
Merci de ton retour. Tu gagnes les points de la meilleure réponse.
Je regarde quand même ton code et ferai peut être quelques commentaires

| Alerter

Répondre à zeb

Lassé par la pub ? Créez un compte

Créer un nouveau sujet

Contenus similaires :

Tags :

VB
excel