XL 2013 Filtrer listbox par rapport a combobox

Youpsy · 5 Avril 2017

Bonjour le forum !!

Qu'il est tout beau tout neuf ! je n'étais pas revenu ici depuis quelque année ! et tout a changer 🙂
J'ai un petit problème et je sais que j'ai toujours trouver solution sur ce site 😎
Alors voila j'ai un problème pour filtrer une listbox par rapport a la valeur de(s) combobox.
Et j'aimerai que ce filtre agisse si une seule ou plusieurs combobox sont utilisée.
Pour des raisons d'utilisation je ne veux pas de listview, trop souvent absent des autres machines

La listbox que je souhaite filtrer tire sa source de la feuille installation et j'aimerai pouvoir filtrer selon le site, le domaine et le CFH ou même une recherche simple par textbox...

un grand merci d'avance a ceux qui prendrons un peu de temps pour mon problème !

Dranreb · 5 Avril 2017

bonjour.
Si le contenu de la ListBox est lui même tiré d'un tableau de données, partez donc de ce tableau.
L'objet ComboBoxLiées n'a besoin que de ce tableau. Pas de listes, pas de filtres, pas de programmation hormis son cahier de charges.

Youpsy · 5 Avril 2017

Merci pour vos réponse qui m'ont déjà aidé un peu !
Mais je n'arrive pas à adapter le code a mon utilisation 🙁

Je me suis inspiré du lien que BISSON m'a donné, plus précisement les cas de
"Filtre Array Multi-colonnes avec 1 ou 2 conditions"
sur http://boisgontierjacques.free.fr/pages_site/formulairecascade.htm#FiltreListBox

J'ai crée un module contenant le code suivant :

Code:

Function FiltreMultiCol2Transp(Tbl, colClé1, Clé1, ColResult, Optional colClé2, Optional Clé2, Optional colClé3, Optional Clé3)
  If IsMissing(colClé2) Then colClé2 = colClé1: Clé2 = Clé1
  If IsMissing(colClé3) Then colClé3 = colClé1: Clé3 = Clé1
  LB = LBound(ColResult) + 1: UB = UBound(ColResult) - LBound(ColResult) + 1
  Dim b(): n = 0
  For i = LBound(Tbl, 1) To UBound(Tbl, 1)
  If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé2) = Clé2 Then
  If Tbl(i, colClé1) = Clé1 And Tbl(i, colClé3) = Clé3 Then
  n = n + 1: ReDim Preserve b(LB To UB, 1 To n)
  For c = LBound(ColResult) To UBound(ColResult)
  b(c + 1, n) = Tbl(i, ColResult(c))
  Next c
  End If
  Next i
  If n > 0 Then FiltreMultiCol2Transp = b
End Function

puis sur l'userform6 ceci..

Code:

Private Sub UserForm_Initialize()
   Set f = Sheets("Installations")
   BD = f.Range("A2:AY" & f.[A65000].End(xlUp).Row).Value
   '--- combobox villes trié
   Set d = CreateObject("Scripting.Dictionary")
   For i = LBound(BD) To UBound(BD)
    d(BD(i, 2)) = ""
   Next i
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.Recherche_SiteCbx.List = temp
  
   '--- combobox profession trié
   Set d = CreateObject("Scripting.Dictionary")
   For i = LBound(BD) To UBound(BD)
    d(BD(i, 5)) = ""
   Next i
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.Recherche_DomaineCbx.List = temp
   '---
   TriMult BD, LBound(BD), UBound(BD), 1
   Me.ListBox1.List = BD
   
    Set d = CreateObject("Scripting.Dictionary")
   For i = LBound(BD) To UBound(BD)
    d(BD(i, 5)) = ""
   Next i
   temp = d.keys
   Tri temp, LBound(temp), UBound(temp)
   Me.Recherche_CfhCbx.List = temp
   '---
   TriMult BD, LBound(BD), UBound(BD), 1
   Me.ListBox1.List = BD
  

End Sub
Private Sub Recherche_SiteCbx_click()
   If Me.Recherche_DomaineCbx <> Me.Recherche_CfhCbx <> "" Then
     Clé1 = Me.Recherche_SiteCbx: colClé1 = 2
     Clé2 = Me.Recherche_DomaineCbx: colClé2 = 5
     Clé3 = Me.Recherche_CfhCbx: colClé2 = 7
     b = FiltreMultiCol2Transp(BD, colClé1, Clé1, Array(1, 2, 3, 4, 5, 6, 7), colClé2, Clé2, colClé3, Clé3)
     If Not IsEmpty(b) Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
   Else
     Clé1 = Me.Recherche_SiteCbx: colClé1 = 2
     b = FiltreMultiCol2Transp(BD, colClé1, Clé1, Array(1, 2, 3, 4, 5, 6, 7))
     If Not IsEmpty(b) Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
   End If
End Sub
Private Sub Recherche_DomaineCbx_click()
   If Me.Recherche_SiteCbx <> Me.Recherche_CfhCbx <> "" Then
     Clé1 = Me.Recherche_SiteCbx: colClé1 = 2
     Clé2 = Me.Recherche_DomaineCbx: colClé2 = 5
      Clé3 = Me.Recherche_CfhCbx: colClé2 = 7
     b = FiltreMultiCol2Transp(BD, colClé1, Clé1, Array(1, 2, 3, 4, 5, 6, 7), colClé2, Clé2, colClé3, Clé3)
     If Not IsEmpty(b) Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
   Else
     Clé1 = Me.Recherche_DomaineCbx: colClé1 = 5
     b = FiltreMultiCol2Transp(BD, colClé1, Clé1, Array(1, 2, 3, 4, 5, 6, 7))
     If Not IsEmpty(b) Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
   End If
End Sub
Private Sub Recherche_CfhCbx_click()
   If Me.Recherche_SiteCbx <> Me.Recherche_DomaineCbx_click <> "" Then
     Clé1 = Me.Recherche_SiteCbx: colClé1 = 2
     Clé2 = Me.Recherche_DomaineCbx: colClé2 = 5
      Clé3 = Me.Recherche_CfhCbx: colClé2 = 7
     b = FiltreMultiCol2Transp(BD, colClé1, Clé1, Array(1, 2, 3, 4, 5, 6, 7), colClé2, Clé2, colClé3, Clé3)
     If Not IsEmpty(b) Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
   Else
     Clé1 = Me.Recherche_DomaineCbx: colClé1 = 5
     b = FiltreMultiCol2Transp(BD, colClé1, Clé1, Array(1, 2, 3, 4, 5, 6, 7))
     If Not IsEmpty(b) Then Me.ListBox1.Column = b Else Me.ListBox1.Clear
   End If
End Sub

Sub TriMult(a, gauc, droi, ColTri) ' Quick sort
  Ref = a((gauc + droi) \ 2, ColTri)
  g = gauc: d = droi
  Do
    Do While a(g, ColTri) < Ref: g = g + 1: Loop
    Do While Ref < a(d, ColTri): d = d - 1: Loop
    If g <= d Then
      For c = LBound(a, 2) To UBound(a, 2)
        temp = a(g, c): a(g, c) = a(d, c): a(d, c) = temp
      Next
      g = g + 1: d = d - 1
    End If
  Loop While g <= d
  If g < droi Then Call TriMult(a, g, droi, ColTri)
  If gauc < d Then Call TriMult(a, gauc, d, ColTri)
End Sub
Sub Tri(a, gauc, droi) ' Quick sort
   Ref = a((gauc + droi) \ 2)
   g = gauc: d = droi
   Do
     Do While a(g) < Ref: g = g + 1: Loop
     Do While Ref < a(d): d = d - 1: Loop
     If g <= d Then
       temp = a(g): a(g) = a(d): a(d) = temp
       g = g + 1: d = d - 1
     End If
   Loop While g <= d
   If g < droi Then Call Tri(a, g, droi)
   If gauc < d Then Call Tri(a, gauc, d)
End Sub

Mais ca ne marche pas comme je voudrais, voir pas du tout 😕

Youpsy · 6 Avril 2017

Un immense merci pour tes solutions !!

Youpsy · 6 Avril 2017

Par contre y a t il un autre moyen pour indiquer la source des column header autres que la création d'un label car les en tête sont toute décalée..?

Et j'ai adapter le code "Recherche multi mots" que tu m'as joint pour mon USF3 et a présent je ne peux plus reporter les valeurs de ma listbox vers des textbox... car avant je renseignai simplement la propiété rowsource et rappeler les valeur j'utilisai ce code

Code:

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Sheets("Installations").Select
Install_IdTxt.Value = Cells(ListBox1.ListIndex + 2, 1)
Install_StieCbx.Value = Cells(ListBox1.ListIndex + 2, 2)

etc..

Y'a t'il un autre moyen ?

Lone-wolf · 6 Avril 2017

Bonjour Youpsy 🙂, Nicole 🙂

Une proposition: met une autre listbox, dans userform_initialize

VB:

With ListBox2
' À adapter comme la listbox1
        .ColumnCount = 8
        .ColumnWidths = "40;80;80;70;70;70;60;50"
        .RowSource = "Feuil1!$A$1:$H$1"
End With

Youpsy · 6 Avril 2017

Oui ca pourrai aller sauf que ma listbox a 52 colonnes et que les en-tête de première colonne corresponde mais si je fais défilé la suite ne joue plus..

Lone-wolf · 6 Avril 2017

OH MY GOODNESS!! 😱 52 COLONNES!! 😵

Tu veux faire quoi avec toutes ces colonnes, y inscrire les 52 années à venir?! 😕😀

EDIT: où alors mettre 4 listbox de 13 colonnes, un peu tiré par les cheveux, mais ce n'est qu'une idée.

EDIT2: autre idée toute simple, tu rempli la listbox à partir de la 1ère ligne(entêtes).

thebenoit59 · 7 Avril 2017

Bonjour Youpsy, le fil, le forum.
Est-il nécessaire d'avoir les 52 colonnes dans le listbox ?

Effectuez une recherche sur Excel Downloads...

XL 2013 Filtrer listbox par rapport a combobox

Youpsy

XLDnaute Junior

Pièces jointes

Dranreb

XLDnaute Barbatruc

Pièces jointes

Youpsy

XLDnaute Junior

Pièces jointes

Youpsy

XLDnaute Junior

Youpsy

XLDnaute Junior

Lone-wolf

XLDnaute Barbatruc

Youpsy

XLDnaute Junior

Lone-wolf

XLDnaute Barbatruc

thebenoit59

XLDnaute Accro

Discussions similaires

Nous accordons de l'importance à votre vie privée