Filtre dynamique VBA Listbox simplification de code

Le 26/05/2021 à 21:47

J'ai créé un code avec mes recherches à droite à gauche, afin de créer une recherche dynamique à l'aide de 3 TextBox.
Cela fonctionne très bien, ma question est de savoir, s'il est possible de simplifier ce code ? En effet je le trouve lourd.
Pouvez-vous m'aider s'il vous plaît .
Merci

16filtre-listbox-vba.xlsm (21.14 Ko)
Private Sub UserForm_Initialize()
    Dim Rng  As Range
    Dim f  As Worksheet

  Set f = Sheets("BD")
  Set Rng = f.Range("A2:C" & f.[A65000].End(xlUp).Row)
  Me.ListBox1.ColumnCount = 3
  Me.ListBox1.ColumnWidths = "50;50;50"
  Me.ListBox1.List = Rng.Value
End Sub

Private Sub TextBox1_Change()
Dim i As Integer
Dim a As Integer
    TextBox1.Text = UCase(TextBox1.Text)
    Me.ListBox1.Clear
    For i = 2 To Application.WorksheetFunction.CountA(Worksheets("BD").Range("A:A"))
    a = Len(Me.TextBox1.Text)
    If Left(Worksheets("BD").Cells(i, 1).Value, a) = Left(Me.TextBox1.Text, a) Then
    Me.ListBox1.AddItem Worksheets("BD").Cells(i, 1).Value
    Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("BD").Cells(i, 2).Value
    Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("BD").Cells(i, 3).Value
End If
Next i
End Sub

Private Sub TextBox2_Change()
Dim i As Integer
Dim a As Integer
    TextBox2.Text = UCase(TextBox2.Text)
    Me.ListBox1.Clear
    For i = 2 To Application.WorksheetFunction.CountA(Worksheets("BD").Range("A:A"))
    a = Len(Me.TextBox2.Text)
    If Left(Worksheets("BD").Cells(i, 2).Value, a) = Left(Me.TextBox2.Text, a) Then
    Me.ListBox1.AddItem Worksheets("BD").Cells(i, 1).Value
    Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("BD").Cells(i, 2).Value
    Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("BD").Cells(i, 3).Value
End If
Next i
End Sub

Private Sub TextBox3_Change()
Dim i As Integer
Dim a As Integer
    TextBox3.Text = UCase(TextBox3.Text)
    Me.ListBox1.Clear
    For i = 2 To Application.WorksheetFunction.CountA(Worksheets("BD").Range("A:A"))
    a = Len(Me.TextBox3.Text)
    If Left(Worksheets("BD").Cells(i, 3).Value, a) = Left(Me.TextBox3.Text, a) Then
    Me.ListBox1.AddItem Worksheets("BD").Cells(i, 1).Value
    Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("BD").Cells(i, 2).Value
    Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("BD").Cells(i, 3).Value
End If
Next i
End Sub
Le 26/05/2021 à 22:20

Bonsoir,

Il y a peut-être un autre moyen pour faire encore plus court.

Public TxtBAct As Long

Private Sub UserForm_Initialize()
    Dim Rng  As Range
    Dim f  As Worksheet

  Set f = Sheets("BD")
  Set Rng = f.Range("A2:C" & f.[A65000].End(xlUp).Row)
  Me.ListBox1.ColumnCount = 3
  Me.ListBox1.ColumnWidths = "50;50;50"
Me.ListBox1.List = Rng.Value
End Sub
Private Sub TextBox1_Change()
TxtBAct = Right(TextBox1.Name, 1)
Call TxtBox_Change
End Sub
Private Sub TextBox2_Change()
TxtBAct = Right(TextBox2.Name, 1)
Call TxtBox_Change
End Sub
Private Sub TextBox3_Change()
TxtBAct = Right(TextBox3.Name, 1)
Call TxtBox_Change
End Sub
Sub TxtBox_Change()
Dim i As Integer
Dim a As Integer
Me.Controls("TextBox" & TxtBAct).Text = UCase(Me.Controls("TextBox" & TxtBAct).Text)
    Me.ListBox1.Clear
    For i = 2 To Application.WorksheetFunction.CountA(Worksheets("BD").Range("A:A"))
        a = Len(Me.Controls("TextBox" & TxtBAct).Text)
            If Left(Worksheets("BD").Cells(i, TxtBAct).Value, a) = Left(Me.Controls("TextBox" & TxtBAct).Text, a) Then
                Me.ListBox1.AddItem Worksheets("BD").Cells(i, 1).Value
                Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("BD").Cells(i, 2).Value
                Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("BD").Cells(i, 3).Value
            End If
    Next i
End Sub

Ici, je récupère le numéro de ta textbox puis je déclare ce variant en public pour que je puisse la reprendre dans une seule et même macro pour toutes les textbox.

Je sais pas si on peut faire un module de classe avec des txtbox donc j'ai fait trois macro d'appel.

voilà ce que je sais faire, mais j'apprends...

Leakim

Le 27/05/2021 à 00:26

Bonsoir,

@Leakim

Nul besoin de classe, l'idée d'un module commun est la bonne. En revanche, inutile de se compliquer la vie avec l'indice des TextBox qui peuvent d'ailleurs changer de nom.

ci-dessous code dans la continuité de ce qu'a proposé Leakim

Private Sub TextBox1_Change()
    TxtBox_Change TextBox1, "A"
End Sub
Private Sub TextBox2_Change()
    TxtBox_Change TextBox2, "B"
End Sub
Private Sub TextBox3_Change()
    TxtBox_Change TextBox3, "C"
End Sub

Sub TxtBox_Change(txtbox As Object, colonne As String)
    Dim i As Integer
    Dim a As Integer

    txtbox.Text = UCase(txtbox.Text)
    Me.ListBox1.Clear
    For i = 2 To Application.WorksheetFunction.CountA(Worksheets("BD").Range("A:A"))
        a = Len(txtbox.Text)
            If Left(Worksheets("BD").Cells(i, colonne).Value, a) = Left(txtbox.Text, a) Then
                Me.ListBox1.AddItem Worksheets("BD").Cells(i, 1).Value
                Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("BD").Cells(i, 2).Value
                Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("BD").Cells(i, 3).Value
            End If
    Next i

End Sub
Le 27/05/2021 à 00:49

@Leakim @thev merci beaucoup pour votre aide.
C'est clairement moins lourd, encore merci d'avoir partagé vos idées.

Pensez-vous qu'il est possible de créer une boucle sur cette partie, sur le projet final il y aura beaucoup plus de colonne :

                Me.ListBox1.AddItem Worksheets("BD").Cells(i, 1).Value
                Me.ListBox1.List(ListBox1.ListCount - 1, 1) = Worksheets("BD").Cells(i, 2).Value
                Me.ListBox1.List(ListBox1.ListCount - 1, 2) = Worksheets("BD").Cells(i, 3).Value

Je voulais faire une boucle ici : Worksheets("BD").Cells(i, 2).Value

mais ca ne fonctionne pas.

Le 27/05/2021 à 07:23

Bonjour,

Dela peux-tu nous mettre ton code qui bug ?

Thev, merci cela me donne des idées pour mes codes. Autodidacte via le forum, tu viens de m'ouvrir les portes des paramètres macro ()

Question : Pourquoi "colonne" tu l'informes par des lettres et non pas par des chiffres. Je pensais que pour cell(ligne, colonne) on devait mettre du numérique comme ci dessous ?

Private Sub TextBox1_Change()
    TxtBox_Change TextBox1, 1
End Sub

Leakim

Le 27/05/2021 à 07:59

Bonjour

@Leakim

Tu peux utiliser l'objet Cells(i, "A") équivalent à Range("A" & i) et tout aussi parlant.

Le 27/05/2021 à 11:27

Bonjour,

Si vous voulez vous simplifier la vie, utilisez un tableau structuré : menu Insertion --> bouton Tableau

ci-dessous exemple de code :

Private Sub UserForm_Initialize()

    Me.ListBox1.ColumnCount = 3
    Me.ListBox1.ColumnWidths = "50;50;50"

    With Range("Tableau1").ListObject
        Me.ListBox1.List = .DataBodyRange.Value
    End With

End Sub
Private Sub TextBox1_Change()
    TxtBox_Change
End Sub
Private Sub TextBox2_Change()
    TxtBox_Change
End Sub
Private Sub TextBox3_Change()
    TxtBox_Change
End Sub
Sub TxtBox_Change()
    Dim i As Integer, j As Integer
    Dim tb(): tb = Array("")

    With Range("Tableau1").ListObject
        j = 0
        For i = 1 To .ListRows.Count
            If UCase(.ListColumns("A1").DataBodyRange.Rows(i)) Like UCase(TextBox1.Text) & "*" _
            And UCase(.ListColumns("A2").DataBodyRange.Rows(i)) Like UCase(TextBox2.Text) & "*" _
            And UCase(.ListColumns("A3").DataBodyRange.Rows(i)) Like UCase(TextBox3.Text) & "*" _
            Then
                ReDim Preserve tb(j): tb(j) = .DataBodyRange.Rows(i).Value
                j = j + 1
            End If
        Next i
    End With

    Me.ListBox1.Clear
    If UBound(tb) > -1 Then Me.ListBox1.Column = Application.Transpose(tb)

End Sub

ci_jointe version

22filtre-listbox-vba.xlsm (23.09 Ko)
Le 27/05/2021 à 22:51

@thev c'est génial, un grand merci. En plus j'ai vraiment compris le cheminement.

Merci beaucoup, à tous les deux pour votre aide !

Bien cordialement,

Rechercher des sujets similaires à "filtre dynamique vba listbox simplification code"