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

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

1 个答案: