Как отфильтровать несколько столбцов в базе данных на основе всех элементов из нескольких списков форм?

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