VBA realtime filter Listbox через текстовое поле

Question

Я хотел бы отфильтровать список, созданный из списка значений, хранящихся на листе, в зависимости от текста, написанного в текстовом поле, содержащемся в той же пользовательской форме.

Мой список содержит 4 или 5 столбцов (в зависимости от выбора OptionField), и я хотел бы искать все столбцы для написанного текста.

Пример: Я пишу «aaa» в TextField, и Listbox должен возвращать список на основе всех строк, чей столбец 1 или 2 или 3 или 4 или 5 содержат «aaa».

Ниже мой код, чтобы обновить список по выбору OptionField (этот код не производит никакой ошибки, просто чтобы показать, как я создаю мой список):

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 

Answer 1

Наконец я мог выйти с чем-то!

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 

Answer 2

Я знаю, ответ пару лет ...

Но я думал, что я разделю решение, которое работает лучше для меня, потому что фильтр пылающий быстро даже тогда, когда есть тысячи элементов в списке. Это не без «улова», хотя: он использует словарь объект

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