Filtre dynamique VBA Listbox simplification de code
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
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
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
- Messages
- 4'096
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
@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.
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
- Messages
- 4'096
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
Bonjour
@Leakim
Tu peux utiliser l'objet Cells(i, "A") équivalent à Range("A" & i) et tout aussi parlant.
- Messages
- 4'096
- Excel
- 2021 FR 64 bits
- Inscrit
- 13/06/2016
- Emploi
- bénévole associations Goutte d'Or
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
@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,