Excel vba combobox recherche intuitive et affichage sur lisbox
kikoudz
Messages postés6Date d'inscriptionlundi 20 septembre 2021StatutMembreDernière intervention13 octobre 2021
-
Modifié le 13 oct. 2021 à 20:25
cs_Le Pivert
Messages postés7902Date d'inscriptionjeudi 13 septembre 2007StatutContributeurDernière intervention14 novembre 2023
-
13 oct. 2021 à 16:19
Bonjour
je suis entrain de réaliser un Userform de recherche intuitive et trie sur combobox a 5 niveaux avec affichage sur listbox a 13 colonnes.
1er combobox récupère les données de la colonne 21 "U"
2e combobox récupère les données de la colonne 8 "H"
3e combobox récupère les données de la colonne 4 "D"
4e combobox récupère les données de la colonne 3 "C"
5e combobox récupère les données de la colonne 6 "F"
j'ai essayé avec ce code mais sans succès j'ai réussi seulement a récupéré les données de la 1er combobox ci-déssus le code utilisé.
Merci d'avance
Private Sub UserForm_Initialize()
Me.ComboBox1.Enabled = False
Me.ComboBox2.Enabled = False
Me.ComboBox3.Enabled = False
Me.ComboBox4.Enabled = False
Me.ComboBox5.Enabled = False
Dim Dico As Object
Dim Plage As Range
Dim Cel As Range
With Worksheets("liste"): Set Plage = .Range(.Cells(7, 21), .Cells(.Rows.Count, 21).End(xlUp)): End With
Set Dico = CreateObject("Scripting.Dictionary")
For Each Cel In Plage: Dico(Cel.Value) = "": Next Cel
Tri Dico
Me.ComboBox1.List = Dico.Keys
End Sub
Private Sub ComboBox1_Change()
Dim Dico As Object
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
Dim nom As Variant
Dim j As Integer
'Me.ListBox1.ColumnCount = 13
With Worksheets("liste"): Set Plage = .Range(.Cells(7, 21), .Cells(.Rows.Count, 21).End(xlUp)): End With
Set Dico = CreateObject("Scripting.Dictionary")
Set Cel = Plage.Find(Me.ComboBox1.Text, , xlValues, xlWhole)
Adr = Cel.Address
Do
Dico(Cel.Offset(, 8).Value) = ""
Set Cel = Plage.FindNext(Cel)
'j = 0
'Me.ListBox1.AddItem& .Cells(Plage.Row, 2).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 3).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 6).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 5).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 11).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 12).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 9).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 14).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 15).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 16).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 23).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 18).Value
'Me.ListBox1.AddItem& .Cells(Plage.Row, 19).Value
'j = j + 1
Loop While Adr <> Cel.Address
Tri Dico
Me.ComboBox2.Clear
Me.ComboBox2.List = Dico.Keys
End Sub
Private Sub ComboBox2_Change()
Dim Dico As Object
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
With Worksheets("liste"): Set Plage = .Range(.Cells(7, 8), .Cells(.Rows.Count, 8).End(xlUp)): End With
Set Dico = CreateObject("Scripting.Dictionary")
Set Cel = Plage.Find(Me.ComboBox2.Text, , xlValues, xlWhole)
Adr = Cel.Address
Do
Dico(Cel.Offset(, 8).Value) = ""
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
Tri Dico
Me.ComboBox3.Clear
Me.ComboBox3.List = Dico.Keys
End Sub
Private Sub ComboBox3_Change()
Dim Dico As Object
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
With Worksheets("liste"): Set Plage = .Range(.Cells(7, 4), .Cells(.Rows.Count, 3).End(xlUp)): End With
Set Dico = CreateObject("Scripting.Dictionary")
Set Cel = Plage.Find(Me.ComboBox3.Text, , xlValues, xlWhole)
Adr = Cel.Address
Do
Dico(Cel.Offset(, 4).Value) = ""
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
Tri Dico
Me.ComboBox4.Clear
Me.ComboBox4.List = Dico.Keys
End Sub
Private Sub ComboBox4_Change()
Dim Dico As Object
Dim Plage As Range
Dim Cel As Range
Dim Adr As String
With Worksheets("liste"): Set Plage = .Range(.Cells(7, 3), .Cells(.Rows.Count, 6).End(xlUp)): End With
Set Dico = CreateObject("Scripting.Dictionary")
Set Cel = Plage.Find(ComboBox4.Text, , xlValues, xlWhole)
Adr = Cel.Address
Do
Dico(Cel.Offset(, 3).Value) = ""
Set Cel = Plage.FindNext(Cel)
Loop While Adr <> Cel.Address
Tri Dico
ComboBox5.Clear
ComboBox5.List = Dico.Keys
End Sub
Sub Tri(Dico As Object)
Dim Tbl()
Dim Cle
Dim I As Integer, j As Integer
Dim Tempo
For Each Cle In Dico.Keys
ReDim Preserve Tbl(0 To I): Tbl(I) = Cle: I = I + 1
Next Cle
For I = 0 To UBound(Tbl): For j = I + 1 To UBound(Tbl) '- 1
If Tbl(I) > Tbl(j) Then
Tempo = Tbl(j): Tbl(j) = Tbl(I): Tbl(I) = Tempo
End If
Next j, I
Dico.RemoveAll
For I = 0 To UBound(Tbl): Dico(Tbl(I)) = "": Next I
End Sub