XL 2013 Filtre dynamique VBA Listbox simplification de code

dela

XLDnaute Nouveau
Bonjour à tous,

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, donc déjà merci à tous ceux qui apportent leurs aides dans le forum.
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 :)

VB:
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
 

Pièces jointes

  • filtre Listbox VBA.xlsm
    21.1 KB · Affichages: 38

Discussions similaires

Réponses
4
Affichages
420