Filtrer une listbox via un command button

Le 14/03/2021 à 15:23

Bonjour à tous,

Je suis bloqué depuis quelques jours sur une demande qui m'a été faite. Les usagers de mon service voudraient avoir la possibilité de filtrer une listbox via un bouton.

Les usagers rentrent dans les différentes textbox les données qu'ils veulent chercher et sur la listbox. Il y a les données qui se rapprochent le plus à ce qu'ils ont tapé dans les différentes textbox qui s'affichent. Ils voudraient faire afficher les affaires qui sont en cours et exclure les affaires closes ou annulées.

J'ai donc fait ceci mais il affiche 4 fois la même ligne (c'est due au mauvais paramétrage de la boucle if)

  • Le code : 
    Private Sub Recherche_EnCours_Click()
Dim no_ligne As Integer
no_ligne = Recherche_RefNumArt.ListIndex + 2 & Recherche_Fab.ListIndex + 2 & Recherche_RespVS.ListIndex + 2 & Recherche_RefDoc.ListIndex + 2 & Recherche_NumArt.ListIndex + 2
Application.ScreenUpdating = False
Recherche_Liste.Clear

    If Recherche_RefNumArt <> "" & Recherche_Fab <> "" & Recherche_RespVS <> "" & Recherche_RefDoc <> "" & Recherche_NumArt <> "" Then
        For Ligne = 2 To 5000
            If ActiveSheet.Cells(Ligne, 10).Text = "En cours" Then
                If ActiveSheet.Cells(Ligne, 1).Text Like "*" & Recherche_RefNumArt & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
                If ActiveSheet.Cells(Ligne, 6) Like "*" & Recherche_Fab & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
                If ActiveSheet.Cells(Ligne, 17) Like "*" & Recherche_RespVS & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
                If ActiveSheet.Cells(Ligne, 13) Like "*" & Recherche_RefDoc & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
                If ActiveSheet.Cells(Ligne, 4) Like "*" & UCase(Recherche_NumArt) & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
            End If
        Next
    End If
End Sub
  • Le résultat du code dans la ListBox :
resultat 1

Bonne après midi !

Le 14/03/2021 à 17:33

Je viens de trouver la solution, il fallait juste faire plusieurs end if à la suite.

Le code pour ceux qui le veulent :

Private Sub Recherche_EnCours_Click()
Dim no_ligne As Integer
no_ligne = Recherche_RefNumArt.ListIndex + 2 & Recherche_Fab.ListIndex + 2 & Recherche_RespVS.ListIndex + 2 & Recherche_RefDoc.ListIndex + 2 & Recherche_NumArt.ListIndex + 2
Application.ScreenUpdating = False
Recherche_Liste.Clear

    If Recherche_RefNumArt <> "" Then
        For Ligne = 2 To 5000
            If ActiveSheet.Cells(Ligne, 10).Text = "En cours" Then
                If ActiveSheet.Cells(Ligne, 1).Text Like "*" & Recherche_RefNumArt & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
            End If
        Next
    End If

    If Recherche_Fab <> "" Then
        For Ligne = 2 To 5000
            If ActiveSheet.Cells(Ligne, 10).Text = "En cours" Then
                If ActiveSheet.Cells(Ligne, 6).Text Like "*" & Recherche_Fab & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
            End If
        Next
    End If

    If Recherche_RespVS <> "" Then
        For Ligne = 2 To 5000
            If ActiveSheet.Cells(Ligne, 10).Text = "En cours" Then
                If ActiveSheet.Cells(Ligne, 17).Text Like "*" & Recherche_RespVS & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
            End If
        Next
    End If

    If Recherche_RefDoc <> "" Then
        For Ligne = 2 To 5000
            If ActiveSheet.Cells(Ligne, 10).Text = "En cours" Then
                If ActiveSheet.Cells(Ligne, 13).Text Like "*" & Recherche_RefDoc & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
            End If
        Next
    End If

    If Recherche_NumArt <> "" Then
        For Ligne = 2 To 5000
            If ActiveSheet.Cells(Ligne, 10).Text = "En cours" Then
                If ActiveSheet.Cells(Ligne, 4).Text Like "*" & Recherche_NumArt & "*" Then
                    Recherche_Liste.AddItem ActiveSheet.Cells(Ligne, 1).Text & " " & ActiveSheet.Cells(Ligne, 4) & " " & ActiveSheet.Cells(Ligne, 12) & " " & ActiveSheet.Cells(Ligne, 6)
                End If
            End If
        Next
    End If
End Sub

Ce code pourrait bien évidemment être amélioré pour plus d'efficacité

Le 15/03/2021 à 01:34

Bonjour Kains,

Voici un essai de factorisation du code :

Private Sub Recherche_EnCours_Click()
Dim no_ligne As Integer
no_ligne = Recherche_RefNumArt.ListIndex + 2 & Recherche_Fab.ListIndex + 2 & Recherche_RespVS.ListIndex + 2 & Recherche_RefDoc.ListIndex + 2 & Recherche_NumArt.ListIndex + 2
Application.ScreenUpdating = False
Recherche_Liste.Clear
tcrit = array(Recherche_RefNumArt, Recherche_Fab, Recherche_RespVS, Recherche_RefDoc, Recherche_NumArt)

for i = lbound(tcrit) to ubound(tcrit)
    If tcrit(i) <> "" Then
        with Activesheet
            For Ligne = 2 To 5000
                If .Cells(Ligne, 10).Text = "En cours" Then
                    If .Cells(Ligne, 1).Text Like "*" & tcrit(i) & "*" Then
                        Recherche_Liste.AddItem .Cells(Ligne, 1).Text & " " & .Cells(Ligne, 4) & " " & .Cells(Ligne, 12) & " " & .Cells(Ligne, 6)
                    End If
                End If
            Next Ligne
        end with
    End If
next i

End Sub

Cdlt,

Rechercher des sujets similaires à "filtrer listbox via command button"