VBAリアルタイムフィルタリストボックスのセル値

Question

ワークシートにリストボックスがあり、指定されたセルをクリックするとアクティブになります。このセルに書いてリストボックスをフィルタリングしたいと思います。例えば、そのセルに "asd"と書くと、リストボックスは "asd"で始まる行をリアルタイムで返します。

Private Sub Worksheet_Change(ByVal Target As Range) 
    On Error Resume Next 
    If Target.Value <> "" Then 
     With ListBox1 
     For i = .ListCount - 1 To 0 Step -1 
      If InStr(1, LCase(.List(i, 0)), LCase(Target.Value)) = 0 And _ 
      InStr(1, LCase(.List(i, 1)), LCase(Target.Value)) = 0 And _ 
      InStr(1, LCase(.List(i, 2)), LCase(Target.Value)) = 0 And _ 
      InStr(1, LCase(.List(i, 3)), LCase(Target.Value)) = 0 Then 
       .RemoveItem i 
      End If 
      Next i 
     End With 
    End If 
End Sub 

私はそれを持っていますが、動作しません。

Answer 1

あなたがこの方法を試すことができます - 特定のセルが変更されたときにちょうどListBoxからすべての項目を削除し、ソースRangeからアイテムを照合して移入：例えば

Option Explicit 

Private Sub Worksheet_Change(ByVal Target As Range) 

    Dim strFilter As String 
    Dim rngData As Range 
    Dim lngCounter As Long 

    ' check changed cell is our specific cell and exit if not 
    If Intersect(Target, Sheet1.Range("B1")) Is Nothing Then 
     Exit Sub 
    End If 

    'get reference to data range 
    Set rngData = Sheet1.Range("A1:A12") 

    'get value of changed cell 
    strFilter = Target.Value 

    'clear listbox and add matching items 
    Sheet1.ListBox1.Clear 
    For lngCounter = 1 To rngData.Rows.Count 
     If Left(rngData.Cells(lngCounter, 1).Value, 1) = Target.Value Then 
      Sheet1.ListBox1.AddItem rngData.Cells(lngCounter, 1).Value 
     End If 
    Next lngCounter 

End Sub 

：