我有一个带有多个列表框的表单。列表框1至4具有较大的项目列表。列表框5至8如下显示列表框1至4中的选定项目:列表框5显示了列表框1中的选定项目,列表框6显示了从列表框2中选定的项目,依此类推。
我想基于列表框5到8中的项目来过滤数据库。列表框5是用于过滤第一数据库列的条件,列表框6是用于第二列的条件,依此类推。
下面的代码可以正常工作,但是即使所有列表框5到8上面都有项目。这意味着,如果我将列表框5至8中的一个或多个留空,则过滤器根本不起作用,并且找到0条记录。那不是这个主意。
换句话说:即使我没有从所有列表框1到4中选择数据,我也希望对数据库进行过滤。我尝试了多种方法,但是没有任何效果。有任何想法吗?预先感谢!
Private Sub CommandButton1_Click()
Dim Db As ListObject
Set Db = Sheets(6).ListObjects("Database")
Dim i, j, k, l As Integer
Dim x, y, z, s As Variant
'Listbox 5 to column 1
ReDim x(0)
Application.ScreenUpdating = False
'For all items in the listbox
For i = 0 To ListBox5.ListCount - 1
x(UBound(x)) = Me.ListBox5.List(i)
ReDim Preserve x(UBound(x) + 1)
Next i
'Filter first column by the selected item
Db.DataBodyRange.AutoFilter Field:=1, Criteria1:=x, Operator:=xlFilterValues
Application.ScreenUpdating = True
''''''''''''''''''''''''''''''''''''
'Listbox 6 to column 2
ReDim y(0)
Application.ScreenUpdating = False
For j = 0 To ListBox6.ListCount - 1
y(UBound(y)) = Me.ListBox6.List(j)
ReDim Preserve y(UBound(y) + 1)
Next j
'Filter second column by the selected item
Db.DataBodyRange.AutoFilter Field:=2, Criteria1:=y, Operator:=xlFilterValues
Application.ScreenUpdating = True
''''''''''''''''''''''''''''''''''''
'Listbox 7 to column 3
ReDim z(0)
Application.ScreenUpdating = False
For k = 0 To ListBox7.ListCount - 1
z(UBound(z)) = Me.ListBox7.List(k)
ReDim Preserve z(UBound(z) + 1)
Next k
'Filter second column by the selected item
Db.DataBodyRange.AutoFilter Field:=3, Criteria1:=z, Operator:=xlFilterValues
Application.ScreenUpdating = True
''''''''''''''''''''''''''''''''''''
'Listbox 8 to column 4
ReDim s(0)
Application.ScreenUpdating = False
For l = 0 To ListBox8.ListCount - 1
s(UBound(s)) = Me.ListBox8.List(l)
ReDim Preserve s(UBound(s) + 1)
Next l
'Filter second column by the selected item
Db.DataBodyRange.AutoFilter Field:=4, Criteria1:=s, Operator:=xlFilterValues
Application.ScreenUpdating = True
End Sub
答案 0 :(得分:1)
您可以执行以下操作:
Private Sub CommandButton1_Click()
Dim Db As ListObject
Dim n As Long
Dim arr, lb As MSForms.ListBox
Set Db = Sheets(6).ListObjects("Table1")
Db.DataBodyRange.AutoFilter '<< clear filter
For n = 5 To 8
Set lb = Me.Controls("ListBox" & n) '<< get the list from its name
If lb.ListCount > 0 Then '<< ignore empty lists
arr = ListArray(lb)
Db.DataBodyRange.AutoFilter Field:=(n - 4), Criteria1:=arr, _
Operator:=xlFilterValues
End If
Next n
End Sub
'get list content as an array
Function ListArray(lst As Object) As Variant
Dim i As Long, arr()
If lst.ListCount > 0 Then
ReDim arr(0 To lst.ListCount - 1)
For i = 0 To lst.ListCount - 1
arr(i) = lst.list(i)
Next i
End If
ListArray = arr
End Function