Excel VBA - Données, Dico, et MsgBox

Le 17/05/2011 à 13:02

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
Le 17/05/2011 à 14:33

Bonjour,

Ci joint un fichier qui doit convenir.

Voir le VBA, j'ai supprimé l'objet dicoprofs et mis un tableau de taille variable.

et intégrer le fait de pouvoir écrire "Lundi" ou "lundi" et aussi supprimer les secondes dans les tranches horaires.

Attention au balayge des feuilles si tu dois ajouter d'autres feuilles ...

28ciju6pnyng.zip (28.79 Ko)
Le 17/05/2011 à 14:56

Fregoli, je suis in love!

Ca fait quelques jours que je me débats avec ce code! Merci beaucoup!

Je vais donc l'étudier maintenant. Me permets tu de t interroger s'il y a quelques trucs que j'ai du mal à assimiler?

Merci encore!

Le 17/05/2011 à 15:06

Bonjour à tous,

J'avais commencé à regarder sur ton 1er poste, j'ai continué sur ce fichier

Poste: https://forum.excel-pratique.com/excel/excel-fonctions-recherche-et-si-t23207.html

La macro traite toutes les feuilles placées derrière la feuille "Cours"

Attention à ne pas mettre de MFC dans les tableaux "Prof", les cellules colorées

sont considérées comme "Non dispo"

Sub Dispo()
Dim Lg%, i%, F%, J%
Dim Jh%, Cpt%
'Macro par Claude Dubois pour "Guillaume831" Excel-Pratique le 17 mai 2011
        Application.ScreenUpdating = False
        Lg = Range("h65536").End(xlUp).Row
        Range("L15:L" & Lg + 10).ClearContents
    For i = 15 To Lg
        For F = 3 To Worksheets.Count
            With Worksheets(F)
                    J = Application.Match(Cells(i, "h"), .Rows(3), 0) 'jour
                For Jh = 4 To 24 'heures
                    If .Cells(Jh, "b") >= Cells(i, "i") And _
                        .Cells(Jh, "b") <= Cells(i, "j") And _
                        .Cells(Jh, J) <> "" Or _
                        .Cells(Jh, J).Interior.ColorIndex <> xlNone Then  'occupé
                            Cpt = Cpt + 1
                            Exit For
                    Else
                        Cpt = 0
                    End If
                Next Jh
                    If Cpt = 0 Then Cells(i, "L") = Cells(i, "L") & .Range("e1") & " - "
            End With
        Next F
    Next i

    For i = 15 To Lg
        '-- supprime le dernier tiret de droite
        Cells(i, "L") = Mid(Cells(i, "L"), 1, Len(Cells(i, "L")) - 3)
    Next i
    Columns("L").AutoFit
End Sub

Tu peux agrandir la plage de recherche

à tester

Amicalement

Claude

23guillaume831-dispo-2.xlsm (36.34 Ko)
Le 17/05/2011 à 15:13

Claude, je viens de tester, je te remercie aussi! Franchement dégaine aussi ton code...

Je vais l'étudier. Si j'ai des questions quant à celui-ci, me permet-s tu de te contacter pour une brève explication?

Dans tous les cas, merci et bonne journée!

Guillaume

Rechercher des sujets similaires à "vba donnees dico msgbox"