将VBA FilterX函数改为活动工作表可用的Sub过程并设置快捷键

修改后的完整代码 #

Sub FilterX()
    Dim rng As Range, dict, c    
    Dim lastrow As Long, n As Long    
    Set dict = CreateObject("Scripting.Dictionary")    

    ' 配置筛选列与容差
    With dict    
        .Add "L"
        .Add "M", 0 ' +/- 0
    '   .Add "N",
        .Add "O", 1 ' +/- 1
    '   .Add "P",
    '   .Add "Q",
        .Add "R", 2
    '   .Add "S",
    '   .Add "T",
        .Add "U", 1
    '   .Add "V",
        .Add "W", 1
    '   .Add "X",
    '   .Add "Y",
        .Add "Z", 2
    End With

    With ActiveSheet
        ' 移除现有筛选
        If .FilterMode = True Then .ShowAllData
       
        ' 获取最后一行行号
        lastrow = .UsedRange.Row + .UsedRange.Rows.Count - 1
        If lastrow < 3 Then
             Exit Sub ' 数据行数不足，直接退出
        End If
        
        Set rng = .Range("A1:AZ" & lastrow)
        
        ' 对指定列应用筛选
        For Each c In dict.keys
            n = .Cells(1, c).Column ' 修正：加上.确保引用当前工作表的单元格
            ' 根据第2行的值和容差设置筛选条件
            rng.AutoFilter Field:=n, Criteria1:=">=" & (.Cells(2, n) - dict(c)), _
                    Operator:=xlAnd, Criteria2:="<=" & (.Cells(2, c) + dict(c))
        Next
        
        ' 可选：如果需要在状态栏显示筛选结果数量，取消下面注释
        ' On Error Resume Next
        ' Application.StatusBar = "筛选后可见行数：" & .Range("A3:A" & lastrow).SpecialCells(xlCellTypeVisible).Count
        ' On Error GoTo 0
    End With
    
End Sub

关键改动说明 #

• 将原Function改为Sub，移除所有返回值相关代码
• 用ActiveSheet替代原函数的ws参数，直接作用于当前活动工作表
• 修正单元格引用：原代码中Cells(1, c).Column未指定工作表，改成.Cells(1, c).Column避免跨表引用错误
• 调整退出逻辑：将Exit Function改为Exit Sub

设置Ctrl+W快捷键 #

1. 按下Alt+F11进入VBA编辑器，将上述代码粘贴到一个标准模块中
2. 返回Excel界面，点击开发工具选项卡（未显示可通过「文件-选项-自定义功能区」调出）
3. 点击宏按钮，选中列表里的FilterX，点击选项
4. 在弹出窗口的「快捷键」输入框按下Ctrl+W，点击确定即可

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