Использование CheckBox в качестве кнопок автофильтра (Excel VBA)

Question

Я хочу использовать несколько (5) флажков для фильтрации одного столбца в таблице Excel.Фильтруемый столбец содержит несколько маркеров, а именно

 "","r","x","s","t"

Вот изображение коробок:

Моя цель - отметить несколько полейи включите все столбцы с указанным маркером.Использование простых методов приводит к тому, что предыдущий фильтр очищается вместо того, чтобы быть «добавленным».

Здесь изображение моих (теперь двух) столбцов отслеживания, один из которых содержит идентификатор, а другой скрытый, преобразующий также заголовки флажка с помощью ifs операторов, так что решение @ zac работает.

Я много раз осмотрелся и нашел на MrExcel ветку, где был предоставлен какой-то код, однако я не смог его адаптировать кмои точные потребности.К сожалению, какая бы кнопка не нажималась, она по умолчанию остается пустой ("").

Ниже приведен мой код для саба, который должен вызываться каждым флажком.

Справочная информация:
Значение идентификатора определено в таблице и ему присвоен динамический именованный диапазон "tracking" Фильтруемый столбец называется ("Project Flag")
Код содержится в отдельном модуле.

Sub Project_Filter()
    Dim objcBox As Object
    Dim cBox As Variant
    Set Dbtbl = Sheets("Database").ListObjects("Entire")
    ReDim cBox(0)

    Dim trackers() As String
    Dim i As Integer
    Dim x As Variant

      i = -1
        For Each x In Range("Tracking").Cells 'reading named range into array
            i = i + 1
            ReDim Preserve trackers(i) As String
            trackers(i) = x.Value
        Next x

    Application.ScreenUpdating = False
    With Sheets("Database")
            For Each objcBox In .OLEObjects
                If TypeName(objcBox.Object) = "CheckBox" Then 'looking for checkboxes
                    If objcBox.Object.Value = True Then
                        cBox(UBound(cBox)) = trackers(i) 'setting cbox array as nth trackers value
                        i = i + 1
                        ReDim Preserve cBox(UBound(cBox) + 1)
                    End If
                End If
            Next
        If IsError(Application.Match((cBox), 0)) Then
            MsgBox "Nothing Selected"
            Exit Sub
        End If

        ReDim Preserve cBox(UBound(cBox))
        If Not .AutoFilterMode Then
            Dbtbl.Range.AutoFilter
            Dbtbl.Range.AutoFilter Field:=Dbtbl.HeaderRowRange.Find("Project Flag").Column, Criteria1:=Array(cBox)
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Итак, после некоторых проб и ошибок я обнаружил, что массив cbox () содержит только первое значение моего массива трекеров, следовательно, он фильтрует только пустые записи.Не знаю, что вызывает это, но подумал, что это может быть примечательно

Answer 1

Основываясь на нашем разговоре и изображении ваших флажков в вашем описании, мы можем получить текст фильтра из заголовка:

Option Explicit

Sub Project_Filter()

    Dim oOLE As Object
    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet1")   ' <--- Remeber to change this
    Dim aFilter As Variant
    Dim sFilterChar As String

    ' Referenc the sheet
    With oWS

        ' If 'All Projects' checkbox is selected, unselect all other checkboxes
        If .OLEObjects("chkAll").Object.Value Then

            ClearCheckboxes

        End If

        ' Loop to capture all selected check boxes
        For Each oOLE In .OLEObjects

            If TypeName(oOLE.Object) = "CheckBox" And oOLE.Object.Value And oOLE.Object.Caption <> "All Projects" Then

                If Not IsArray(aFilter) Then
                    ReDim aFilter(0)
                Else
                    ReDim Preserve aFilter(UBound(aFilter) + 1)
                End If

                sFilterChar = Mid(oOLE.Object.Caption, 2, 1)
                If sFilterChar = "]" Then
                    aFilter(UBound(aFilter)) = ""
                Else
                    aFilter(UBound(aFilter)) = sFilterChar
                End If

            End If

        Next

        ' Set the filter based on selection
        If IsArray(aFilter) Then
            .ListObjects("Table1").Range.AutoFilter field:=2, Criteria1:=aFilter, Operator:=xlFilterValues
        Else
            .ListObjects("Table1").Range.AutoFilter
        End If

    End With

    ' Clear Object
    Set oWS = Nothing

End Sub

' Clear all checkboxes other than 'All Projects' checkbox
Private Sub ClearCheckboxes()

    Dim oOLE As Object
    Dim oWS As Worksheet: Set oWS = ThisWorkbook.Worksheets("Sheet1")   ' <--- Remeber to change this

    With oWS

        ' Clear checkboxes
        For Each oOLE In .OLEObjects

            If TypeName(oOLE.Object) = "CheckBox" And oOLE.Object.Caption <> "All Projects" Then

                If oOLE.Object.Value Then
                    oOLE.Object.Value = False
                End If

            End If

        Next

    End With

    ' Clear object
    Set oWS = Nothing

End Sub

ПРИМЕЧАНИЕ : у меня есть All Projects в качестве флажка