Listbox selon critères evolutifs

Bonjour

Dans le doc joint très simplifié je cherche à afficher dans ma Listbox1 les lignes correspondantes de BD selon :

  • Site choisi dans le Combobox1
  • Si dans le même temps en colonne 2 on trouve Plan ou Schéma
Set Ws = Sheets(2)
With Me.ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "50;200;50"
    i = 0
    For J = 2 To Ws.Range("A" & Rows.Count).End(xlUp).Row
        If Ws.Range("A" & J) Like ComboBox1 And Ws.Range("B" & J) Like "Plan" Then
                .AddItem
                .List(i, 0) = Ws.Cells(J, 1).Value
                .List(i, 1) = Ws.Cells(J, 2).Value
                .List(i, 2) = J
            i = i + 1
        End If
        If Ws.Range("A" & J) Like ComboBox1 And Ws.Range("B" & J) Like "Schéma" Then
                .AddItem
                .List(i, 0) = Ws.Cells(J, 1).Value
                .List(i, 1) = Ws.Cells(J, 2).Value
                .List(i, 2) = J
            i = i + 1
        End If
    Next J
End With

Le problème est que ce 2° critère risque d'évoluer et je cherche à lister ce 2° critère (Feuille 1, colonne C) afin de charger la listbox selon un nombre de critère ("OU") indéfini à l'avance (comme ça pas besoin de retoucher le code au cas où ...)

J'espère avoir été assez clair.

Merci d'avance

Bonjour,

Voici le code complet souhaité, avec déclaration des variables!

Option Explicit

Private Sub UserForm_Initialize() '
Dim Sites As Range
With Sheets(1)
    Set Sites = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
End With
ComboBox1.List = Sites.Value
End Sub

Private Sub ComboBox1_Change()
Dim Ws As Worksheet, i As Long, j As Long, criteres As Variant, cpt As Integer
With Sheets(1)
    criteres = .Range("C2:C" & .Cells(.Rows.Count, 1).End(xlUp).Row).Value
End With
Set Ws = Sheets(2)
With Me.ListBox1
    .Clear
    .ColumnCount = 3
    .ColumnWidths = "50;200;50"
    i = 0
    For j = 2 To Ws.Range("A" & Rows.Count).End(xlUp).Row
        For cpt = LBound(criteres) To UBound(criteres)
            If Ws.Range("A" & j) Like ComboBox1 And Ws.Range("B" & j) Like criteres(cpt, 1) Then
                .AddItem
                .List(i, 0) = Ws.Cells(j, 1).Value
                .List(i, 1) = Ws.Cells(j, 2).Value
                .List(i, 2) = j
                i = i + 1
            End If
        Next cpt
    Next j
End With
End Sub

Super, c'est parfait

Merci Franck et bonne journée

Rechercher des sujets similaires à "listbox criteres evolutifs"