通过文本框搜索以自动更新列表框条目

Question

我想在用户窗体的列表框中实现搜索功能，以便更好地查看许多列，但遗憾的是我找不到解决方案。

最佳解决方案是，如果我可以在文本框中搜索任何行内容（最多 12 列包含诸如姓名、ID、职位、组织等数据）并且列表框会自动更新显示所有匹配条目。

在UserForm_Initialize中我填写了如下列表框：

Private Sub UserForm_Initialize()
 
With UserForm1
  .StartUpPosition = 1
  .Top = 1
  .Left = 1
End With
 
Dim last As Integer
         last = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).row + 1
 
ListBox1.ColumnCount = 12
ListBox1.ColumnHeads = True
ListBox1.ColumnWidths = "30;50;200;60;30;110;110;90;50;40;50;80;60"
ListBox1.RowSource = "A2:M" & last
 
End Sub

我想象搜索功能根据Textbox1 中的输入过滤列表框。

经过长时间的研究和考虑（不幸的是，我是一个绝对的 vba 业余爱好者），创建了以下代码：

Private Sub TextBox1_Change()
    Dim i As Long
    On Error Resume Next
    Me.TextBox1.Text = StrConv(Me.TextBox1.Text, vbProperCase)
    Me.ListBox1.Clear
    For i = 2 To Application.WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
        For x = 1 To 12
            a = Len(Me.TextBox1.Text)
            If Left(ActiveSheet.Cells(i, x).Value, a) = Me.TextBox1.Text And Me.TextBox1.Text <> "" Then
                Me.ListBox1.AddItem ActiveSheet.Cells(i, x).Value
                For c = 1 To 12
                    Me.ListBox1.List(ListBox1.ListCount - 1, c) = ActiveSheet.Cells(i, c + 1).Value
                Next c
            End If
        Next x
    Next i
End Sub

我的问题：是否有人有更智能/更精简的解决方案，或者可以帮助我的代码正常运行，因为目前我在执行时收到了runtime error '9'。

Answer 1

通过搜索项过滤显示列表框

在原帖中出现了组的问题，所以你必须考虑几个点。

由于他们中的一些人经常被问到纯粹是有条不紊的问题，因此此汇编可能有助于获得更全面的观点。

• 一个重要的问题是对每个要显示的单个元素使用.AddItem 方法， 仅当您尝试显示更多列时，列表框的列数默认为 10 列
  从而引发索引错误。

• 如果你坚持重复的.AddItem方法， 您可以使用 workaround 来克服 10 列限制： 列表框的临时数组分配就足够了 将列数增加到对应的数组列数。

• 此外，afaik 不可能自行清除或过滤列表框数据， 如果它们受.RowSource 属性的约束。 因此，有必要不使用 .RowSource 并以编程方式添加数据。
  - 或者，您可以将 .RowSource 基于预先过滤的范围（例如，在隐藏的工作表中） )。

• 这意味着另一个缺点：无法显示标题 只需将.ColumnHeads 属性设置为True 而不设置.RowSource。 - 这就是为什么我选择妥协，在下面的答案中将头像作为第一个数据行。

• 请注意，如果在同一过程中将文本框字符串内容更改为正确的大小写，TextBox1_Change 事件将/将被第二次调用。因此，您需要通过一些转义代码行来防止重复的数据输入。

• 此外，只需找到给定搜索项的第一次出现并防止不必要的循环（例如，通过设置布尔变量 found）。

以下示例代码演示了如何处理显示的问题，试图 尽可能遵循原始方法 （即使通过 VBA 循环通过 range 而不是 array 对于更大的数据集可能会很耗时，并且您的命名约定可能比@987654331更喜欢更有意义的变量名@或c):

Option Explicit                 ' declaration head of Userform code module

Private Sub TextBox1_Change()
    Dim ws as WorkSheet             ' declare data sheet as WorkSheet
    set ws = Sheet1             ' << define data sheet's Code(Name)
    With Me.ListBox1
        .Clear                                  ' remove any prior items from listbox
        .List = ws.Range("A1:M1").Value2        ' display head & provide for sufficient columns
    End With
    If Me.TextBox1.Text = "" Then Exit Sub      ' no further display, so escape
    Dim SearchText As String
    SearchText = StrConv(Me.TextBox1.Text, vbProperCase)
    If Me.TextBox1.Text <> SearchText Then      ' avoid double call of Change event
        Me.TextBox1.Text = SearchText           ' display ProperCase
        Exit Sub                                ' force 2nd call after text change
    End If
    With ws
        Dim i As Long
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Dim lngth As Long: lngth = Len(SearchText)
            Dim x As Long
            For x = 1 To 12                         ' range columns
                Dim found As Boolean
                If Left(.Cells(i, x).Value, lngth) = SearchText Then
                    Me.ListBox1.AddItem .Cells(i, x).Value
                    Dim c As Long
                    For c = 1 To 12
                        Me.ListBox1.List(ListBox1.ListCount - 1, c) = .Cells(i, c + 1).Value
                    Next c
                    found = True                    ' check for 1st occurrence avoiding redundant loops
                End If
                If found Then
                    found = False
                    Exit For                        ' 1st finding suffices
                End If
            Next x
        Next i
    End With
End Sub

Private Sub UserForm_Initialize()

With Me
  .StartUpPosition = 1
  .Top = 1
  .Left = 1
End With

With Me.ListBox1
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'assign 2-dim array to .List property
    'to overcome default column count of 10 only!!
    '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    .Clear
    'needed to overcome default limit of 10 columns only!
    .List = Sheet1.[A1:M1].Value2          ' only column heads (i.e. 1 row) to start with
   '.RemoveItem 1                          ' (delete eventually if no head needed at all)
    .ColumnCount = 13
    .ColumnWidths = "30;50;100;60;30;110;110;90;50;40;50;80;60"
End With
  
End Sub