通过文本框搜索以自动更新列表框条目 [英] Search via textbox to auto-update listbox entries

问题描述

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

I would like to implement a search function in a listbox in a userform getting a better view of the many columns and unfortunately I can't find a solution.

最佳解决方案是，如果我可以在文本框中搜索任何行内容(最多12列，其中包含名称，ID，位置，组织等数据)，列表框将自动更新以显示所有内容匹配条目.

The optimal solution would be, if I could search in a textbox for any row content (up to 12 columns containing data like e.g. name, ID, position, organization, ...) and the listbox would automatically update itself showing all matching entries.

在 UserForm_Initialize 中，我按如下所示填充了列表框:

In UserForm_Initialize I filled the listbox as follows:

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 中的输入，搜索功能可以过滤列表框.

I imagined the search function to filter the listbox depending on the input in Textbox1.

经过长时间的研究和考虑(不幸的是，我是绝对的vba业余爱好者)，创建了以下代码:

After long research and consideration (unfortunately I am an absolute vba amateur) the following code was created:

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'.

My question: Does anyone have a smarter / leaner solution or could maybe help to get my code working as currently I get the runtime error '9' on execution.

推荐答案

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

在原始帖子中出现了一个 set 个问题，因此您必须考虑几个点.

In the original post occurs a set of issues, so you have to consider several points.

由于其中一些人经常被当作纯粹的方法性问题而被问到，因此该汇编可能有助于获得更全面的了解.

As some of them get asked frequently as pure methodical questions, this compilation might help to gain a more overall view besides.

• 一个重要的问题是，对于要显示的每个元素，都使用 .AddItem 方法，仅当您尝试显示更多列时，列表框的列数才默认为 10列
  因此会产生索引错误.

• An important issue is that using the .AddItem method for each single element to be displayed, the listbox'es column count defaults to 10 columns only whereas you try to display more columns
  thus raising an indexing error.

如果您坚持使用重复的 .AddItem 方法，您可以使用解决方法来克服10列限制:临时将数组分配给列表框就足够了将列数增加到相应的数组列数.

If you stick to the repetitive .AddItem method, you may use a workaround to overcome the 10 columns limitation: a temporary array assignment to the list box is sufficient to increase the number of columns to the corresponding number of array columns.

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

Furthermore and afaik it's not possible to clear or filter listbox data themselves, if they are bound by the .RowSource property. Therefore it would be necessary to do without .RowSource and to add data programmatically.
- Alternatively you might base .RowSource on a pre-filtered range (e.g. in a hidden sheet).

这意味着进一步的缺点:无法显示字幕只需将 .ColumnHeads 属性设置为 True ，而无需设置 .RowSource .--这就是为什么我通过在下面的答案中将heads作为第一个数据行来选择某种折衷的原因.

This means a further drawback: there's no way to display captions simply by setting the .ColumnHeads property to True without a set .RowSource. - That's why I chose sort of compromise by including heads as first data row in the answer below .

请注意，如果您在同一过程中将文本框字符串内容更改为适当的Case，则将再次调用 TextBox1_Change 事件.因此，您需要通过一些转义代码行来防止重复输入数据.

Note that the TextBox1_Change event will/would be called a second time if you change the textbox string content to proper Case within the same procedure. Therefore you need to prevent redoubled data entries by some escape code lines.

此外，找到给定搜索项的第一个匹配项并防止不必要的循环(例如，通过设置布尔变量 found )就足够了.

Furthermore it suffices to find the first occurrence of the given search item and to prevent unnecessary loops (e.g. by setting a boolean variable found).

以下示例代码演示了如何处理试图解决的所示问题尽可能遵循原始方法(即使通过VBA遍历 range 而不是 array 来获取更多数据集也很耗时，而且您的命名约定可能更喜欢使用比更有意义的变量名> x 或 c ):

The following example code demonstrates how to handle the shown issues trying to follow the original approach as close as possible (even if looping through a range instead of an array by means of VBA can be time consuming for greater data sets and your naming convention could prefer more meaningful variable names than x or 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

这篇关于通过文本框搜索以自动更新列表框条目的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！