问题
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.
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.
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
I imagined the search function to filter the listbox depending on the input in Textbox1.
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
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.
回答1:
ListBox display via filtering by search item
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.
An important issue is that using the
.AddItemmethod 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.If you stick to the repetitive
.AddItemmethod, 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.Furthermore and afaik it's not possible to clear or filter listbox data themselves, if they are bound by the
.RowSourceproperty. Therefore it would be necessary to do without.RowSourceand to add data programmatically.
- Alternatively you might base.RowSourceon a pre-filtered range (e.g. in a hidden sheet).This means a further drawback: there's no way to display captions simply by setting the
.ColumnHeadsproperty toTruewithout a set.RowSource. - That's why I chose sort of compromise by including heads as first data row in the answer below .Note that the
TextBox1_Changeevent 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.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).
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
来源：https://stackoverflow.com/questions/64818906/search-via-textbox-to-auto-update-listbox-entries