XL 2021 Alimenter Listbox si colonne 3 contient un mot précis

[Claudinedu13]

Bonjour,
C'est encore moi et mes listbox
@patricktoulon Ton code marche super bien et il est tellement bien fait que je l'ai mis plusieurs fois dans mon formulaire
J'ai juste une petite demande , je n'arrive pas à trouver toute seule comment faire,
je voudrais alimenter ma listbox uniquement quand la catégorie (colonneD) contient "test" ?
Merci

'code and algorithm created by patricktoulon
Option Explicit
Option Compare Text
Dim TabRefVal
Dim col
Sub reliste()
    TabRefVal = Feuil5.Range("B2:D" & Feuil5.Range("B" & Rows.Count).End(xlUp).Row).Value    '(3 colonnes)
    Call TriT2D(TabRefVal, 3, sens:=1)
    ListBoxRef.List = TabRefVal
End Sub

Private Sub ConfiGListref()
    With ListBoxRef
        .Clear
        .ColumnCount = 3
        .ColumnWidths = "35;175;170"
    End With
End Sub
Function PartListe()
    Dim i&, x As Boolean
    ConfiGListref
    If col = 0 Then col = 1
    For i = 1 To UBound(TabRefVal)
        If OptionButton1 = True Then
        x = InStr(1, TabRefVal(i, col), TextBoxRef) > 0
        Else: x = Left(TabRefVal(i, col), Len(TextBoxRef.Value)) = TextBoxRef.Value
        End If
        If x Then
            With ListBoxRef:
                .AddItem TabRefVal(i, 1): .List(.ListCount - 1, 1) = TabRefVal(i, 2): .List(.ListCount - 1, 2) = TabRefVal(i, 3)
            End With
        End If
    Next
End Function


Private Sub ht1_Click(): Dim i&: col = 1: For i = 1 To 3: Me.Controls("ht" & i).BackColor = &H404040: Next: ht1.BackColor = &H808080: End Sub
Private Sub ht2_Click(): Dim i&: col = 2: For i = 1 To 3: Me.Controls("ht" & i).BackColor = &H404040: Next: ht2.BackColor = &H808080: End Sub
Private Sub ht3_Click(): Dim i&: col = 3: For i = 1 To 3: Me.Controls("ht" & i).BackColor = &H404040: Next: ht3.BackColor = &H808080: End Sub
Private Sub OptionButton1_Change(): With OptionButton1: .ForeColor = Array(vbYellow, vbRed)(Abs(.Value)): End With: End Sub
Private Sub OptionButton2_Change(): With OptionButton2: .ForeColor = Array(vbYellow, vbRed)(Abs(.Value)): End With: End Sub
Private Sub dropbutton_Click(): With ListBoxRef: .Visible = Not .Visible: End With: reliste: End Sub


Private Sub TextBoxRef_Change()    'Filtre ListBoxRef suivant saisi dans TextBoxRef
    If TextBoxRef = "" Then
        reliste
        ListBoxRef.Visible = False
    Else
        PartListe
        ListBoxRef.Visible = True
    End If
End Sub

'------------------------------------------------------------------
'Tri QuickSort Boisgontier
'http://boisgontierj.free.fr/pages_site/tableaux.htm#Tri2DSansIndex
'Exemple: Call TriT2D(tt, 1, LBound(tt, 1), UBound(tt, 1))
'Remastered Options Arguments to Optional by Patricktoulon
'------------------------------------------------------------------
Sub TriT2D(A, Optional ColTri& = -1, Optional gauc = -1, Optional droi = -1, Optional sens& = 1)    ' Quick sort
    Dim ref, g, d, K, temp

    If gauc = -1 Then gauc = LBound(A)
    If droi = -1 Then droi = UBound(A)
    If ColTri = -1 Then ColTri = LBound(A, 2)

    ref = A((gauc + droi) \ 2, ColTri)
    g = gauc: d = droi
    Do
        If sens > 0 Then
            Do While A(g, ColTri) < ref: g = g + 1: Loop
            Do While ref < A(d, ColTri): d = d - 1: Loop
        Else
            Do While A(g, ColTri) > ref: g = g + 1: Loop
            Do While ref > A(d, ColTri): d = d - 1: Loop
        End If
        If g <= d Then
            For K = LBound(A, 2) To UBound(A, 2)
                temp = A(g, K): A(g, K) = A(d, K): A(d, K) = temp
            Next K
            g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call TriT2D(A, ColTri, g, droi, sens)
    If gauc < d Then Call TriT2D(A, ColTri, gauc, d, sens)
End Sub

Private Sub UserForm_Initialize()
    ConfiGListref
    reliste
End Sub

 

[patricktoulon]

re
Bonjour Martine
c'est pourtant simple

Function PartListe()
    Dim i&, x As Boolean, y As Boolean
    ConfiGListref
    If col = 0 Then col = 1
    For i = 1 To UBound(TabRefVal)
        If OptionButton1 = True Then
        x = InStr(1, TabRefVal(i, col), TextBoxRef) > 0
         Else: x = Left(TabRefVal(i, col), Len(TextBoxRef.Value)) = TextBoxRef.Value
        End If
        y = LCase(TabRefVal(i, 3)) = "test"
        x = x And y
        If x Then
            With ListBoxRef:
                .AddItem TabRefVal(i, 1): .List(.ListCount - 1, 1) = TabRefVal(i, 2): .List(.ListCount - 1, 2) = TabRefVal(i, 3)
            End With
        End If
    Next
End Function

 

[patricktoulon]

Martine

 

[Claudinedu13]

re
Bonjour Martine
c'est pourtant simple

Function PartListe()
    Dim i&, x As Boolean, y As Boolean
    ConfiGListref
    If col = 0 Then col = 1
    For i = 1 To UBound(TabRefVal)
        If OptionButton1 = True Then
        x = InStr(1, TabRefVal(i, col), TextBoxRef) > 0
         Else: x = Left(TabRefVal(i, col), Len(TextBoxRef.Value)) = TextBoxRef.Value
        End If
        y = LCase(TabRefVal(i, 3)) = "test"
        x = x And y
        If x Then
            With ListBoxRef:
                .AddItem TabRefVal(i, 1): .List(.ListCount - 1, 1) = TabRefVal(i, 2): .List(.ListCount - 1, 2) = TabRefVal(i, 3)
            End With
        End If
    Next
End Function

Merci Raymond
Simple pour toi , je teste ça de suite !

 

[patricktoulon]

de rien Géraldine

 

[Claudinedu13]

de rien Géraldine

Parfait comme dab , Thank