修改VBA代码后工作表下拉自动筛选取消功能失效求助

代码背景 #

此前借助他人帮助实现了下拉列表筛选工作表的VBA代码，选择筛选条件可对对应列筛选，选"All"时取消该列筛选，示例代码如下：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const HEADER = 8
    If Target.CountLarge > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range("C2:C6")) Is Nothing Then
        Dim vCol, vCrit
        vCol = Application.Match(Target.Offset(0, -1), Me.Rows(HEADER), 0)
        If VBA.IsError(vCol) Then Exit Sub
        With Me.Range("A8").CurrentRegion
            If Target.Value = "All" Then
                If Me.AutoFilterMode Then
                    .AutoFilter Field:=vCol
                End If
            Else
                vCrit = Target.Text
                If IsDate(vCrit) Then
                    .AutoFilter Field:=CLng(CDate(vCol)), Criteria1:=vCrit, Operator:=xlAnd
                Else
                    .AutoFilter Field:=vCol, Criteria1:=vCrit, Operator:=xlFilterValues
                End If
            End If
        End With
    End If
End Sub

适配生产环境时，修改了表头行（改为第7行）和选择范围（B2:B5），修改后的代码如下：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const HEADER = 7
    If Target.CountLarge > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range("B2:B5")) Is Nothing Then
        Dim vCol, vCrit
        vCol = Application.Match(Target.Offset(0, -1), Me.Rows(HEADER), 0)
        If VBA.IsError(vCol) Then Exit Sub
        With Me.Range("A7").CurrentRegion
            If Target.Value = "All" Then
                If Me.AutoFilterMode Then
                    .AutoFilter Field:=vCol
                End If
            Else
                vCrit = Target.Text
                If IsDate(vCrit) Then
                    .AutoFilter Field:=CLng(CDate(vCol)), Criteria1:=vCrit, Operator:=xlAnd
                Else
                    .AutoFilter Field:=vCol, Criteria1:=vCrit, Operator:=xlFilterValues
                End If
            End If
        End With
    End If
End Sub

问题现象 #

生产环境使用的是包含23列的Power Query表，筛选功能正常，但选择"All"时无法取消对应列的筛选。已尝试注释日期处理代码、检查下拉列表文本格式，问题仍未解决。

解决方案 #

问题根源在于Power Query表属于ListObject对象，其筛选机制与普通工作表的AutoFilter存在差异，原代码的判断逻辑不适用于ListObject。以下是修正后的代码：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const HEADER = 7
    Dim tbl As ListObject
    ' 定位到Power Query对应的ListObject（替换为你的实际表名）
    Set tbl = Me.ListObjects("Table1")
    
    If Target.CountLarge > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range("B2:B5")) Is Nothing Then
        Dim vCol, vCrit
        vCol = Application.Match(Target.Offset(0, -1), tbl.HeaderRowRange, 0)
        If VBA.IsError(vCol) Then Exit Sub
        
        If Target.Value = "All" Then
            ' 检查该列是否启用筛选，再取消
            If tbl.ShowAutoFilter Then
                ' 取消指定列的筛选
                tbl.ListColumns(vCol).Range.AutoFilter
            End If
        Else
            vCrit = Target.Text
            If IsDate(vCrit) Then
                tbl.Range.AutoFilter Field:=vCol, Criteria1:=vCrit, Operator:=xlAnd
            Else
                tbl.Range.AutoFilter Field:=vCol, Criteria1:=vCrit, Operator:=xlFilterValues
            End If
        End If
    End If
End Sub

关键修改点 #

• 直接操作ListObject：通过Me.ListObjects("Table1")定位Power Query表，避免CurrentRegion导致的范围偏差
• 修正筛选判断逻辑：使用tbl.ShowAutoFilter判断表是否启用筛选，取消指定列筛选时用tbl.ListColumns(vCol).Range.AutoFilter
• 修复日期处理错误：原代码中CLng(CDate(vCol))是错误逻辑，vCol是列索引，无需转换，直接使用即可

注意：代码中的"Table1"需要替换为你实际的Power Query表名称，可在Excel「表格设计」选项卡中查看表名。

内容的提问来源于stack exchange，提问作者Gary