如何根据多个表单列表框中的所有项目过滤数据库中的多个列?

Question

我有一个包含多个列表框的表单。列表框 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

Answer 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