VBA通过文本框实时过滤列表框 [英] VBA realtime filter Listbox through Textbox
问题描述
我想过滤从存储在工作表中的值列表创建的列表框，这取决于写在同一个用户表单中的文本框中的文本。
我的列表框有4或5列（取决于OptionField选择），我想搜索所有的文字列写入。
例如：我写在TextFieldaaa和Listbox应该返回一个基于列1或2或3或4或5包含aaa的所有行的列表。
在我的代码下面刷新列表OptionField的选择（这段代码不会产生任何错误，它只是显示我如何创建我的列表）：
pre $ Sub c RefreshList（ ）
Dim selcell，firstcell As String
Dim k，i As Integer
Dim r as long
i = 0
k = 0
'从隐藏工作表中读取参数
如果Me.new_schl = True那么
firstcell = Cells（3,4）.Address
selcell = firstcell
直到IsEmpty（范围（& selcell& ））和i = 2
如果IsEmpty（Range（& selcell&））那么i = i + 1
k = k + 1
selcell = Cells 1 + k，7）。地址（0,0）
循环
k = k - 1
selcell =单元格（1 + k，7）.Address（0，0 ）
与Me.ListBox1
$ b $ .ColumnCount = 4
.ColumnWidths =50; 80; 160; 40
.RowSource =
Set MyData = Range（& firstcell&：& selcell&）
.List = MyData.Cells.Value
r = .ListCount - 1 0步骤-1
如果.List（r，3）=或.List（r，3）=0则
.RemoveItem r
End If
Next r
End With
其他
firstcell =单元（3，11）.Address
selcell = firstcell
直到IsEmpty（Range（& selcell&））和i = 11
如果IsEmpty（Range（& selcell&））那么我=我+ 1
k = k + 1
selcell =单元格（1 + k，15）。地址（0,0）
循环
k = k - 1
selcell = （1 + k，15）.Address（0，0）
与Me.ListBox1
.ColumnCount = 5
.ColumnWidths =40; 40; 160; 40;
.RowSource =
Set MyData = Range（& firstcell&：& selcell&）
.List = MyData.Cells.Value
对于r = .ListCount - 1为0 Step -1
如果.List（r，3）=或.List（r，3）=0则
.RemoveItem r
End If
Next r
End With
End If
End Sub
最后，我可以拿出一些东西！
$ b
Sub Filter_Change（）
Dim i As Long
Dim Str As String
Str = Me.Filter.Text
Me.RefreshList
If Not Str =Then
With Me.ListBox1
For如果InStr（1，LCase（.List（i，0）），LCase（Str））= 0并且InStr（1，LCase（.List（i， 1）），LCase（Str））= 0并且__ b $ b InStr（1，LCase（.List（i，2）），LCase（Str））= 0并且InStr（1，LCase （i，3）），LCase（Str））= 0然后
.RemoveItem i
结束如果
下一个我
End With
End If
End Sub
I would like to filter a Listbox created from a list of values stored in a worksheet depending on text written in a textbox contained in the same userform.
My Listbox has 4 or 5 columns (depending on OptionField selection) and I would like to search all the columns for the text written.
Example: I write "aaa" in TextField and the Listbox should return a list based on all the lines whose column 1 or 2 or 3 or 4 or 5 contain "aaa".
Below my code to refresh the list on OptionField selection (this code does not produce any error, it is just to show how I create my list):
Sub RefreshList()
Dim selcell, firstcell As String
Dim k, i As Integer
Dim r as long
i = 0
k = 0
' reads parameters from hidden worksheet
If Me.new_schl = True Then
firstcell = Cells(3, 4).Address
selcell = firstcell
Do Until IsEmpty(Range("" & selcell & "")) And i = 2
If IsEmpty(Range("" & selcell & "")) Then i = i + 1
k = k + 1
selcell = Cells(1 + k, 7).Address(0, 0)
Loop
k = k - 1
selcell = Cells(1 + k, 7).Address(0, 0)
With Me.ListBox1
.ColumnCount = 4
.ColumnWidths = "50; 80; 160; 40"
.RowSource = ""
Set MyData = Range("" & firstcell & ":" & selcell & "")
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Or .List(r, 3) = "0" Then
.RemoveItem r
End If
Next r
End With
Else
firstcell = Cells(3, 11).Address
selcell = firstcell
Do Until IsEmpty(Range("" & selcell & "")) And i = 11
If IsEmpty(Range("" & selcell & "")) Then i = i + 1
k = k + 1
selcell = Cells(1 + k, 15).Address(0, 0)
Loop
k = k - 1
selcell = Cells(1 + k, 15).Address(0, 0)
With Me.ListBox1
.ColumnCount = 5
.ColumnWidths = "40; 40; 160; 40; 40"
.RowSource = ""
Set MyData = Range("" & firstcell & ":" & selcell & "")
.List = MyData.Cells.Value
For r = .ListCount - 1 To 0 Step -1
If .List(r, 3) = "" Or .List(r, 3) = "0" Then
.RemoveItem r
End If
Next r
End With
End If
End Sub
Finally I could come out with something!
Sub Filter_Change()
Dim i As Long
Dim Str As String
Str = Me.Filter.Text
Me.RefreshList
If Not Str = "" Then
With Me.ListBox1
For i = .ListCount - 1 To 0 Step -1
If InStr(1, LCase(.List(i, 0)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 1)), LCase(Str)) = 0 And _
InStr(1, LCase(.List(i, 2)), LCase(Str)) = 0 And InStr(1, LCase(.List(i, 3)), LCase(Str)) = 0 Then
.RemoveItem i
End If
Next i
End With
End If
End Sub
这篇关于VBA通过文本框实时过滤列表框的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
