Remplir une listbox en fonction de deux combobox en cascade

[bentaleb]

Bonjour tout le monde

Je reviens vers vous parce que j'ai besoin d'un code pour remplir une listbox en fonction des choix de deux combobox en cascade.
et j'aimerais savoir s'il en a un qu'on peut adapter suivant le nombre de combobox.

Je vous remercie d'avance .

 

[BOISGONTIER]

Bonjour,

Option Compare Text
Dim TblBD(), NbCol, colThème, ColSThème
Private Sub UserForm_Initialize()
   Set f = Sheets("Base")
   TblBD = f.Range("A2:C" & f.[A65000].End(xlUp).Row).Value
   NbCol = UBound(TblBD, 2)
   colThème = 1: ColSThème = 2
   '--- combobox Thématique
   Set d = CreateObject("Scripting.Dictionary")
   d("*") = ""
   For I = LBound(TblBD) To UBound(TblBD)
    d(TblBD(I, colThème)) = ""
   Next I
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.ComboBox1.List = temp
   Me.ComboBox1.ListIndex = 0
   Affiche
End Sub

Private Sub ComboBox1_click()
   '--- combobox sous thematique trié
   Set d = CreateObject("Scripting.Dictionary")
   d("*") = ""
   For I = LBound(TblBD) To UBound(TblBD)
    If TblBD(I, colThème) = Me.ComboBox1 Then d(TblBD(I, ColSThème)) = ""
   Next I
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.ComboBox2.List = temp
   Me.ComboBox2.ListIndex = 0
   TriMult TblBD, LBound(TblBD), UBound(TblBD), 1
   Affiche
End Sub

Private Sub ComboBox2_click()
   Affiche
End Sub

Sub Affiche()
  Dim Tbl()
  themathique = Me.ComboBox1
  soustheme = Me.ComboBox2
  n = 0
  For I = 1 To UBound(TblBD)
    If TblBD(I, 1) Like themathique And TblBD(I, 2) Like soustheme Then
        n = n + 1: ReDim Preserve Tbl(1 To NbCol, 1 To n)
        For K = 1 To NbCol: Tbl(K, n) = TblBD(I, K): Next K
    End If
  Next I
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     Me.Label3.Caption = Me.ListBox1.ListCount & " Ligne(s)"
  Else
     Me.ListBox1.Clear
     Me.Label3.Caption = ""
  End If
End Sub

Menus en cascade

Boisgontier

 

[Robert]

Bonjour Bentaled, bonjour le forum,

Une proposition avec ces codes :

Private O As Worksheet 'déclare la variable O (Onglet)
Private TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Private D As Object 'déclare la variable D (Dictionnaire)
Private I As Integer 'déclare la variable I (Incrément)

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Me.ListBox1.ColumnCount = 3 'définit le nombre de colonnes de la ListBox1
Set O = Worksheets("Base") 'définit l'onglet O
TV = O.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    D(TV(I, 1)) = "" 'alimente le dictionnaire D avec la données en colonne 1 du tableau des valeurs TV
Next I 'prochaine ligne de la boucle
Me.ComboBox1.List = D.keys 'alimente la ComboBox1 avec les données du dictionnaire D sans doublon
End Sub

Private Sub ComboBox1_Change() 'au changement de la Combobox1
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Integer 'déclare la variable K (incrément)

Me.ComboBox2.Clear 'vide la ComboBox2
Me.ListBox1.Clear 'vide la ListBox1
Erase TL 'vide le tableau TL
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    'si la donnée en colonne 1 de la boucle est égale a la valeur de la ComboBox1, alimente la ComboBox2 avec la donnée en colonne 2 de la boucle
    If TV(I, 1) = Me.ComboBox1.Value Then
        Me.ComboBox2.AddItem TV(I, 2)
        ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 lignes, K colonne)
        TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV
        TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV
        TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If K > 1 Then Me.ListBox1.Column = TL 'si K est supérieure a un, alimente les colonnes de la ListBox1 avec le tableau TL
End Sub

Private Sub ComboBox2_Change() 'au changement de la Combobox1
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)
Dim K As Integer 'déclare la variable K (incrément)

Me.ListBox1.Clear 'vide la ListBox1
Erase TL 'vide le tableau TL
K = 1 'initialise la variable K
For I = 2 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    'condition : si la donnée en colonne 1 de la boucle est égale a la valeur de la ComboBox1 et si la donnée en colonne 2 de la boucle est égale à la ComboBox2
    If TV(I, 1) = Me.ComboBox1.Value And TV(I, 2) = Me.ComboBox2.Value Then
        ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL (3 lignes, K colonne)
        TL(1, K) = TV(I, 1) 'récupère dans la ligne 1 de TL la donnée en colonne 1 de TV
        TL(2, K) = TV(I, 2) 'récupère dans la ligne 2 de TL la donnée en colonne 2 de TV
        TL(3, K) = TV(I, 3) 'récupère dans la ligne 3 de TL la donnée en colonne 3 de TV
        K = K + 1 'incrémente K (ajoute une colonne au tableau des lignes TL)
    End If 'fin de la condition
Next I 'prochaine ligne de la boucle
If K > 1 Then Me.ListBox1.Column = TL 'si K est supérieure a un, alimente les colonnes de la ListBox1 avec le tableau TL
End Sub

[Édition]
Bonjour Maître Jacques, nos posts se sont croisés...

 

[bentaleb]

Rebonjour à tous,

Je vous remercie et c'est exactement ce que je cherchais.

Cordialement

 

[Dranreb]

et j'aimerais savoir s'il en a un qu'on peut adapter suivant le nombre de combobox.

Ceci s'adapterait très facilement s'il y avait des ComboBox supplémentaires.

 

[bentaleb]

C'est Top ! encore merci à tous.