快速循环切换Excel表格数据筛选器

工作表中数据如下图所示。

现在需要添加按钮，实现C列的循环筛选，如下图所示。如果当前表格未启用筛选功能，则首次筛选值为KB-L。

示例代码如下。

Sub CycleFilter()
    Dim aCrit, i As Long, oTab As ListObject, iCol As Long
    Dim sCrit As String
    Const KEYS = "KB-L KB-P KB-C KB-T KB-- KB-L"
    Const TARGET_COL = "Business Unit"
    aCrit = Split(KEYS)
    Set oTab = ActiveSheet.ListObjects(1)
    iCol = oTab.ListColumns(TARGET_COL).Index
    If oTab.AutoFilter Is Nothing Then
        oTab.Range.AutoFilter
    End If
    If oTab.AutoFilter.FilterMode Then
        If oTab.AutoFilter.Filters(iCol).On Then
            sCrit = Mid(oTab.AutoFilter.Filters(iCol).Criteria1, 2)
            sCrit = aCrit((InStr(1, KEYS, sCrit) \ 5) + 1)
        Else
            sCrit = "KB-L"
        End If
    Else
        sCrit = "KB-L"
    End If
    If sCrit = "KB--" Then 
        oTab.Range.AutoFilter Field:=3
    Else
        oTab.Range.AutoFilter Field:=3, Criteria1:="=" & sCrit
    End If
End Sub

【代码解析】
第4行代码定义循环筛选关键字的顺序，其中KB--代表显示全部，即清除筛选条件。
第5行代码定义循环筛选列的标题。
第6行代码将关键字序列拆分为数组。
第7行代码获取工作表中的第一个ListObject对象。
第8行代码获取循环筛选列的Index属性，即该列在表格中的位置序号。
第9行代码判断表格是否启用筛选功能，如果未启用，则第10行代码启用筛选功能。
第12行代码判断表格是否存在筛选过滤。
第13行代码判断指定列是否存在筛选过滤。
如果存在第14行代码获取当前筛选条件的关键字。
第15行代码在关键字列表中查找下一个关键字。
如果表格是不存在筛选过滤，第17行代码设置首次筛选关键字。
第20行代码与第17行代码功能相同。
第22行代码识别指定关键字，第23行代码清除筛选条件关键字。
第25行代码应用新的筛选条件。