VBA通过单元格值实时筛选列表框

我有一个工作表中的列表框，它通过点击一些指定的单元格来激活。 我想通过写在这个单元格上过滤我的列表框。 例如，如果我在该单元格中写入“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 

例如：