☰

如何使用 VBA 连续取消选择/选择特定的自动筛选选项？

tag-icon • tag-icon microsoft-excel vba macros
如何使用 VBA 连续取消选择/选择特定的自动筛选选项？

我正在尝试创建一个宏，它将允许我连续取消选择/选择特定的过滤器选项。

因此在下面的例子中，如果我单击“取消选择类型 1”，那么“类型 1”将从过滤器中删除。

如果我随后单击“取消选择类型 2”，则“类型 2”将从过滤器中取消选择，但“类型 1”也仍将被取消选择。

如果我单击“选择类型 1”，则“类型 1”将被重新选择，而“类型 2”将保持未选择状态。

例子

我尝试使用记录宏功能，但它不适用于后续的取消选择/选择。记录宏功能与 AutoFilter 配合使用的方式是，它会识别仍处于勾选状态的选项并将其添加到数组中，而这不适用于其他按钮的后续录制。以下是录制时取消选择类型 1 时的代码，如您所见，它会将其从勾选的选项数组中删除。

'
' DeselectType1 Macro
'

'
    ActiveSheet.Range("$A$1:$B$25").AutoFilter Field:=1, Criteria1:=Array( _
        "Type 2", "Type 3", "Type 4"), Operator:=xlFilterValues
End Sub

有没有办法编写代码，以便从过滤器中删除特定选项？并允许删除后续选项，如我上面所述？

答案1

你问的问题并不那么简单。你不能为它录制宏，因为宏只记录你设置的最终状态，而不是你实现它的方式。其次，宏不会创建变量来存储过滤器的初始状态。
在这里，你必须先读取初始过滤器设置，然后应用所需的更改。另一个问题是，读取过滤器设置时，其内容取决于条件的数量。1、2 或 3+ 个条件有所不同。幸运的是，当你设置条件时，你可以对许多条件应用 1 个模型，当条件少于 3 个时，Excel 会在内部进行转换。
这是我的建议：

Sub Sel(item As String)
    Dim Crit1, Crit2, Oper As Long
    If Left(item, 1) <> "=" Then item = "=" & item
    ReadFilter Crit1, Crit2, Oper
    If Not ActiveSheet.AutoFilterMode Then
        Selection.AutoFilter Field:=1, Criteria1:=item
    Else
       Select Case Oper
           Case 0, 1
               If Crit1 = item Then Exit Sub
               Crit1 = Array(Crit1, item)
               Oper = 7
           Case 2
               If Crit1 = item Or Crit2 = item Then Exit Sub
               Crit1 = Array(Crit1, Crit2, item)
               Oper = 7
           Case 7
               Dim d As Long
               d = UBound(Crit1)
               ReDim Preserve Crit1(d + 1)
               Crit1(d + 1) = item
        End Select
        Selection.AutoFilter Field:=1, Criteria1:=Crit1, _
            Operator:=Oper, Criteria2:=Crit2
    End If
End Sub

Sub DeSel(item As String)
    Dim Crit1, Crit2, Oper As Long
    If Left(item, 1) <> "=" Then item = "=" & item
    ReadFilter Crit1, Crit2, Oper
    If Not ActiveSheet.AutoFilterMode Then Exit Sub
    Select Case Oper
        Case 0
            If Crit1 = Empty Then
                Crit1 = Filter(AllItems, item, False)
                Oper = 7
            End If
        Case 1
            If Crit1 = item Then
                Selection.AutoFilter Field:=1
            End If
            Exit Sub
        Case 2
            If Crit1 <> item And Crit2 <> item Then Exit Sub
            If item = Crit1 Then Crit1 = Crit2
            Crit2 = Empty
        Case 7
            Crit1 = Filter(Crit1, item, False)
    End Select
    Selection.AutoFilter Field:=1, Criteria1:=Crit1, _
        Operator:=Oper, Criteria2:=Crit2
End Sub

Private Sub ReadFilter(Crit1, Crit2, Oper As Long)
    If ActiveSheet.AutoFilterMode Then
        If Intersect(ActiveSheet.AutoFilter.Range.Columns(1), _
            Selection.CurrentRegion.Columns(1)) Is Nothing Then
            ActiveSheet.AutoFilterMode = False
        End If
    End If
    If ActiveSheet.AutoFilterMode Then
        If ActiveSheet.AutoFilter.Filters(1).On Then
            On Error Resume Next
            With ActiveSheet.AutoFilter.Filters(1)
                Crit1 = .Criteria1
                Oper = .Operator
                Crit2 = .Criteria2
            End With
            On Error GoTo 0
        End If
    End If
End Sub

Private Function AllItems()
    Dim rng As Range, arr
    Set rng = ActiveSheet.AutoFilter.Range.Columns(1)
    Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)  'without header
    arr = rng.Parent.Evaluate(""" ="" & " & rng.Address)
    AllItems = Application.Transpose(arr)
End Function

选择或取消选择项目的过程需要参数。当您将宏分配给按钮时，您必须提供此参数，例如对于选择类型 1，您应该使用：

'Sel "Type 1"'

对于取消选择类型 2：

'DeSel "Type 2"'

整个短语必须用单引号括起来（由于参数的原因）。
要使其工作，您必须将光标放在数据区域中，自动过滤应打开，并且您应用过滤器的列应为过滤区域中的第一列。

相关内容