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

42listboxcascade2.zip (172.52 Ko)

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

listboxcascade2
52listboxcascade5.zip (225.30 Ko)

Bonjour et grand merci

Cela répond tout à fait à ma question !

Rechercher des sujets similaires à "listbox cascade references communes"