ListBox en cascade - références communes
Bonjour,
Je suis nouvelle sur ce forum...
Pouvez-vous m'aider à résoudre mon problème?
J'ai créé sur VBA un formulaire qui permet d'afficher une liste d'agents en fonction de leur affectation dans une administration.
Jusque là tout va bien. Puis les choses se compliquent : Dans un même service, différents métiers peuvent être exercés. Mais dans différents services nous pouvons retrouver les mêmes métiers (ex : le métier "agent d'exploitation" est exercé dans plusieurs centres routiers.
Dans mon ficher : si je sélectionne un métier, les noms d'agents qui s'affichent sont ceux qui exercent ce métier, mais dans tous les services.
Je souhaiterais que ne s'affiche que le nom des agents :
- exerçant le métier sélectionné
- appartenant au service choisi dans la listbox précédente
Je vous joints mon fichier pour plus de clarté.
Merci par avance de votre réponse.
Bonjour,
Simplification du code
Dim f, dchoisis, dchoisis2
Private Sub UserForm_Initialize()
'Ajouter la liste des pôles
Set f = Sheets("BD")
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
mondico(c.Value) = ""
Next c
Me.ListBoxPôle.List = mondico.keys
Me.ListBoxPôle.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub ListBoxPôle_Change()
'Liste des pôles choisis
Set dchoisis = CreateObject("Scripting.Dictionary")
For I = 0 To Me.ListBoxPôle.ListCount - 1
If Me.ListBoxPôle.Selected(I) = True Then dchoisis(Me.ListBoxPôle.List(I, 0)) = ""
Next I
If dchoisis.Count > 0 Then Me.RésultatListBoxPôle.List = dchoisis.keys
'Ajouter la liste des Directions
Me.ListBoxDirection.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
If dchoisis.exists(c.Value) Then mondico(c.Offset(, 1).Value) = ""
Next c
Me.ListBoxDirection.List = mondico.keys
End Sub
Private Sub ListBoxDirection_Change()
'Liste des Directions choisies
Set dchoisis2 = CreateObject("Scripting.Dictionary")
For I = 0 To Me.ListBoxDirection.ListCount - 1
If Me.ListBoxDirection.Selected(I) = True Then dchoisis2(Me.ListBoxDirection.List(I, 0)) = ""
Next I
Me.RésultatListBoxDirection.List = dchoisis2.keys
'Ajouter la liste des services
Me.ListBoxService.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
If dchoisis.exists(c.Value) And dchoisis2.exists(c.Offset(, 1).Value) Then mondico(c.Offset(, 2).Value) = ""
Next c
If dchoisis2.Count > 0 Then Me.ListBoxService.List = mondico.keys
End Sub
Private Sub ListBoxService_Change()
'Liste des services choisis
Set dchoisis3 = CreateObject("Scripting.Dictionary")
For I = 0 To Me.ListBoxService.ListCount - 1
If Me.ListBoxService.Selected(I) = True Then dchoisis3(Me.ListBoxService.List(I, 0)) = ""
Next I
If dchoisis3.Count > 0 Then Me.RésultatListBoxService.List = dchoisis3.keys
'Ajouter la liste des métiers
Me.ListBoxMétier.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
If dchoisis.exists(c.Value) And dchoisis2.exists(c.Offset(, 1).Value) And dchoisis3.exists(c.Offset(, 2).Value) Then mondico(c.Offset(, 3).Value) = ""
Next c
Me.ListBoxMétier.List = mondico.keys
End Sub
Ceuzin
Bonjour,
Dim f, dchoisis, dchoisis2, dchoisis3, dchoisis4
Private Sub UserForm_Initialize()
'Ajouter la liste des pôles
Set f = Sheets("BD")
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
mondico(c.Value) = ""
Next c
Me.ListBoxPôle.List = mondico.keys
Me.ListBoxPôle.MultiSelect = fmMultiSelectMulti
End Sub
Private Sub ListBoxPôle_Change()
'Liste des pôles choisis
Set dchoisis = CreateObject("Scripting.Dictionary")
For I = 0 To Me.ListBoxPôle.ListCount - 1
If Me.ListBoxPôle.Selected(I) = True Then dchoisis(Me.ListBoxPôle.List(I, 0)) = ""
Next I
If dchoisis.Count > 0 Then Me.RésultatListBoxPôle.List = dchoisis.keys Else Me.RésultatListBoxPôle.Clear
'Ajouter la liste des Directions
Me.ListBoxDirection.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
If dchoisis.exists(c.Value) Then mondico(c.Offset(, 1).Value) = ""
Next c
If mondico.Count > 0 Then Me.ListBoxDirection.List = mondico.keys Else Me.RésultatListBoxDirection.Clear
End Sub
Private Sub ListBoxDirection_Change()
'Liste des Directions choisies
Set dchoisis2 = CreateObject("Scripting.Dictionary")
For I = 0 To Me.ListBoxDirection.ListCount - 1
If Me.ListBoxDirection.Selected(I) = True Then dchoisis2(Me.ListBoxDirection.List(I, 0)) = ""
Next I
If dchoisis2.Count > 0 Then Me.RésultatListBoxDirection.List = dchoisis2.keys Else Me.RésultatListBoxDirection.Clear
'Ajouter la liste des services
Me.ListBoxService.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
If dchoisis.exists(c.Value) And dchoisis2.exists(c.Offset(, 1).Value) Then mondico(c.Offset(, 2).Value) = ""
Next c
If mondico.Count > 0 Then Me.ListBoxService.List = mondico.keys Else Me.RésultatListBoxService.Clear
End Sub
Private Sub ListBoxService_Change()
'Liste des services choisis
Set dchoisis3 = CreateObject("Scripting.Dictionary")
For I = 0 To Me.ListBoxService.ListCount - 1
If Me.ListBoxService.Selected(I) = True Then dchoisis3(Me.ListBoxService.List(I, 0)) = ""
Next I
If dchoisis3.Count > 0 Then Me.RésultatListBoxService.List = dchoisis3.keys Else Me.RésultatListBoxService.Clear
'Ajouter la liste des métiers
Me.ListBoxMétier.Clear
Set mondico = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
If dchoisis.exists(c.Value) And dchoisis2.exists(c.Offset(, 1).Value) And dchoisis3.exists(c.Offset(, 2).Value) Then mondico(c.Offset(, 3).Value) = ""
Next c
If mondico.Count > 0 Then Me.ListBoxMétier.List = mondico.keys
End Sub
Private Sub ListBoxMétier_Click()
Me.ListBoxNom.Clear
Set dchoisis4 = CreateObject("Scripting.Dictionary")
For Each c In Range(f.[A2], f.[A65000].End(xlUp))
temp = c.Offset(, 5).Value & " " & c.Offset(, 6).Value
If dchoisis.exists(c.Value) And dchoisis2.exists(c.Offset(, 1).Value) And _
dchoisis3.exists(c.Offset(, 2).Value) And _
c.Offset(, 3).Value = ListBoxMétier Then dchoisis4(temp) = c.Row
Next c
If dchoisis4.Count > 0 Then Me.ListBoxNom.List = dchoisis4.keys
End Sub
Private Sub ListBoxNom_Click()
temp = Me.ListBoxNom
Me.TextBox1 = f.Cells((dchoisis4(temp)), 3)
End Sub
Ceuzin
Bonjour et grand merci
Cela répond tout à fait à ma question !