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作为复选框

将CheckBox用作自动过滤器按钮（excel VBA）

1 个答案: