Bonjour à tous,
Je fais appel à aide,
J'ai cherché et trouvé plusieurs code pour le faire, mais je n'arrive jamais à l'adapter à mon code.
Je veux filtré via des combobox mes données pour faire une recherche.
Mes combobox sont nommés selon leur fonction, donc... je ne peux pas (ou ne souhaite pas) faire de for i to 10... combobox(i) etc....
J'ai trouvé et adapté un code qui fonctionne bien (sur le site de m. boisgontierj), mais qui ne fonctionne que pour une seule colonne, j'aimerais que le code fonctionne pour plusieurs colonne.
Option Compare Text
Dim f, RngBD, ColRecherche
' Appel les combobox, label et listbox au dessus des autres controles
Private Sub BTN_Recherche_Click()
Set f = Sheets("INVENTAIRE")
Set d = CreateObject("Scripting.Dictionary")
Set RngBD = f.[A1].CurrentRegion.Offset(1)
ColRecherche = 2 ' adapter
d("*") = ""
For i = 1 To RngBD.Rows.Count
clé = RngBD.Cells(i, ColRecherche): d(clé) = ""
Next i
UF_Principal.CB_R_Item.List = d.keys ' liste des items sans doublons
UF_Principal.LB_Recherche.ColumnCount = RngBD.Columns.Count
UF_Principal.LB_Recherche.ColumnWidths = "49,95;70;90;49,95;60;40;40;60;40;40;40;44;100;65;65;65;65;139,95" ' à adapter
UF_Principal.LB_Recherche.ColumnHeads = False
End Sub' Combobox de recherche sur les items
Private Sub CB_R_Item_Click()
Set f2 = Sheets("filtre")
f2.Cells.Clear
f2.[Z1] = RngBD.Offset(-1).Cells(1, ColRecherche): f2.[Z2] = Me.CB_R_Item
f.[A1].CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=f2.[Z1:Z2], _
CopyToRange:=f2.[A1], Unique:=False
Set RngFiltre = f2.[A1].CurrentRegion.Offset(1).Resize(f2.[A1].CurrentRegion.Rows.Count - 1)
Me.LB_Recherche.RowSource = RngFiltre.Address(External:=True)
End Sub
comment adapter ce code pour que mes autres combobox (de recherche) puissent fonctionner
(nom des mes autres combobox: CB_R_Fabricant , CB_R_Modele , CB_R_NoSerie , etc)
Optionnel .... est possible que les combobox affiche les données trié ? (oui je sais que ça se fait, mais comment le faire et l'adapté à mon code)
toute aide sera très apprécié.