Excel VBA – 通过文本框search带有多列的用户窗体列表框

我想解决所需的代码来过滤或search包含在一个用户窗体，包含多列和多行的列表框。 在用户窗体上，我有一个文本框，允许用户input，理想情况下过滤掉列表框中的不匹配的条目。

我在网上find了一些解决scheme ，但没有什么可以在一个用户窗体中使用多列的列表框。 它从这个例子编码的方式是试图转换一列数据，我猜我需要改变代码来使用一个数组。 我只是不够强大的VBA知道如何改变这一块。

我也收到GoToRow（）函数的错误，但我相信它是绑在单列与多列列表框的问题。

我已经包含一个链接到我的项目下面的基本模型，因为我使用了一个用户窗体和一个名为的列表框和文本框。

https://www.dropbox.com/s/diu05ncwbltepqp/BasicListboxExample.xlsm?dl=0

我的用户窗体上的列表框有五列，名为ProjectList，文本框被命名为SearchTextBox。

Option Explicit Const ProjectNameCol = "B" Dim PS As Worksheet Private loActive As Excel.ListObject Private Sub UserForm_Activate() ' Main code on Userform Activation, calls support subs Set PS = Sheets("ProjectSheet") 'stores value for Project Sheet Worksheet as PS Set loActive = ActiveSheet.ListObjects(1) 'populates listbox with data from ProjectSheet Worksheet named table ProjectList.RowSource = "AllData" '# of Columns for listbox ProjectList.ColumnCount = 5 'Column Width for listbox ProjectList.ColumnWidths = "140; 100; 100; 100; 100" Me.ProjectList.TextColumn = 1 Me.ProjectList.MatchEntry = fmMatchEntryComplete ResetFilter End Sub Private Sub SearchTextBox_Change() 'Can't get anything to work here ResetFilter End Sub Sub ResetFilter() Dim rngTableCol As Excel.Range Dim varTableCol As Variant Dim RowCount As Long Dim FilteredRows() As String Dim i As Long Dim ArrCount As Long Dim FilterPattern As String 'the asterisks make it match anywhere within the string If Not ValidLikePattern(Me.SearchTextBox.Text) Then Exit Sub End If FilterPattern = "*" & Me.SearchTextBox.Text & "*" Set rngTableCol = loActive.ListColumns(1).DataBodyRange 'note that Transpose won't work with > 65536 rows varTableCol = Application.WorksheetFunction.Transpose(rngTableCol.value) RowCount = UBound(varTableCol) ReDim FilteredRows(1 To 2, 1 To RowCount) For i = 1 To RowCount 'Like operator is case sensitive, 'so need to use LCase if not CaseSensitive If (LCase(varTableCol(i)) Like LCase(FilterPattern)) Then 'add to array if ListBox item matches filter ArrCount = ArrCount + 1 'there's a hidden ListBox column that stores the record num FilteredRows(1, ArrCount) = i FilteredRows(2, ArrCount) = varTableCol(i) End If Next i If ArrCount > 0 Then 'delete empty array items 'a ListBox cannot contain more than 65536 items ReDim Preserve FilteredRows(1 To 2, 1 To Application.WorksheetFunction.Min(ArrCount, 65536)) Else 're-initialize the array Erase FilteredRows End If If ArrCount > 1 Then Me.ProjectList.List = Application.WorksheetFunction.Transpose(FilteredRows) Else Me.ProjectList.Clear 'have to add separately if just one match 'or we get two rows, not two columns, in ListBox If ArrCount = 1 Then Me.ProjectList.AddItem FilteredRows(1, 1) Me.ProjectList.List(0, 1) = FilteredRows(2, 1) End If End If End Sub Private Sub ProjectList_Change() GoToRow End Sub Sub GoToRow() If Me.ProjectList.ListCount > 0 Then Application.Goto loActive.ListRows(Me.ProjectList.value).Range.Cells(1),True End If End Sub 

在我的模块中，我有：

 Function ValidLikePattern(LikePattern As String) As Boolean Dim temp As Boolean On Error Resume Next temp = ("A" Like "*" & LikePattern & "*") If Err.Number = 0 Then ValidLikePattern = True End If On Error GoTo 0 End Function