VBA liste de filtres en temps réel par le biais de zone de texte

Je voudrais filtrer une liste créée à partir d'une liste de valeurs stockées dans une feuille de calcul, selon le texte écrit dans une zone de texte contenus dans le même userform.

Ma Listbox a 4 ou 5 colonnes (selon OptionField de sélection) et je voudrais pour rechercher toutes les colonnes de texte écrit.

Exemple: j'écris "aaa" dans le Champ de texte et de la zone de liste doit retourner une liste basée sur toutes les lignes dont la colonne 1 ou 2 ou 3 ou 4 ou 5 contiennent des "aaa".

Ci-dessous mon code pour actualiser la liste sur OptionField de sélection (ce code ne produit pas d'erreur, c'est juste pour montrer comment je crée ma liste):

Sub RefreshList()
Dim selcell, firstcell As String
Dim k, i As Integer
Dim r as long
i = 0
k = 0
' reads parameters from hidden worksheet
If Me.new_schl = True Then
firstcell = Cells(3, 4).Address
selcell = firstcell
Do Until IsEmpty(Range("" & selcell & "")) And i = 2
If IsEmpty(Range("" & selcell & "")) Then i = i + 1
k = k + 1
selcell = Cells(1 + k, 7).Address(0, 0)
Loop
k = k - 1
selcell = Cells(1 + k, 7).Address(0, 0)
With Me.ListBox1
.ColumnCount = 4
.ColumnWidths = "50; 80; 160; 40"
.RowSource = ""
Set MyData = Range("" & firstcell & ":" & selcell & "")
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Or .List(r, 3) = "0" Then
.RemoveItem r
End If
Next r
End With
Else
firstcell = Cells(3, 11).Address
selcell = firstcell
Do Until IsEmpty(Range("" & selcell & "")) And i = 11
If IsEmpty(Range("" & selcell & "")) Then i = i + 1
k = k + 1
selcell = Cells(1 + k, 15).Address(0, 0)
Loop
k = k - 1
selcell = Cells(1 + k, 15).Address(0, 0)
With Me.ListBox1
.ColumnCount = 5
.ColumnWidths = "40; 40; 160; 40; 40"
.RowSource = ""
Set MyData = Range("" & firstcell & ":" & selcell & "")
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Or .List(r, 3) = "0" Then
.RemoveItem r
End If
Next r
End With
End If
End Sub
est-il un problème avec votre code? Où faut-il jeter une erreur?
Nope, mon code est pour vous de prendre un coup d'oeil sur la façon dont je remplir ma listbox. J'ai essayé de RemoveItem mais ça ne fonctionne pas

OriginalL'auteur Noldor130884 | 2013-06-12

  1. 1

    Enfin je pourrais sortir avec quelque chose! 

    Sub Filter_Change()
Dim i As Long
Dim Str As String
Str = Me.Filter.Text
Me.RefreshList
If Not Str = "" Then
With Me.ListBox1
For i = .ListCount - 1 To 0 Step -1
If InStr(1, LCase(.List(i, 0)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 1)), LCase(Str)) = 0 And _
InStr(1, LCase(.List(i, 2)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 3)), LCase(Str)) = 0 Then
.RemoveItem i
End If
Next i
End With
End If
End Sub

    OriginalL'auteur Noldor130884

  2. 1

    Je sais, la réponse est de deux ans...

    Mais j'ai pensé que je pourrais partager avec vous la solution qui fonctionne le mieux pour moi, parce que le filtre est très rapide même quand il y a des milliers d'éléments dans la liste. Il n'est pas sans un "catch", mais:
    il utilise un objet Dictionary

    Option Explicit
Dim myDictionary As Scripting.Dictionary
Private Sub fillListbox()
Dim iii As Integer
Set myDictionary = New Scripting.Dictionary
' this, here, is just a "draft" of a possible loop 
' for filling in the dictionary
For iii = 1 To RANGE_END
If Not myDictionary.Exists(UNIQUE_VALUE) Then
myDictionary.Add INDEX, VALUE
End If
Next
myListbox.List = myDictionary .Items
End Sub
Private Sub textboxSearch_Change()
Dim Keys As Variant
Keys = myDictionary .Items
myListbox.List = Filter(Keys, textboxSearch.Text, True, vbTextCompare)
End Sub
Private Sub UserForm_Initialize()
Call fillListbox
End Sub

    OriginalL'auteur Tomaski