XL 2013 Filtrer listbox par rapport a combobox

Youpsy

XLDnaute Junior
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 :cool:
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 !
 

Pièces jointes

  • Gestion Parc - Copie.xlsm
    560.6 KB · Affichages: 68

Dranreb

XLDnaute Barbatruc
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.
 

Pièces jointes

  • CBxL.xlsm
    101.1 KB · Affichages: 112

Youpsy

XLDnaute Junior
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 :confused:
 

Pièces jointes

  • Copy of Gestion Parc - Copie.xlsm
    546.4 KB · Affichages: 95
  • Copy of Gestion Parc - Copie.xlsm
    546.4 KB · Affichages: 70

Youpsy

XLDnaute Junior
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

XLDnaute Barbatruc
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
 

Lone-wolf

XLDnaute Barbatruc
OH MY GOODNESS!! :eek: 52 COLONNES!! o_O

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

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).
 
Dernière édition:

Discussions similaires

Réponses
26
Affichages
1 K

Statistiques des forums

Discussions
312 929
Messages
2 093 715
Membres
105 794
dernier inscrit
mallet