当筛选条件值缺失时，如何实现Excel VBA AutoFilter自动筛选？

直接用On Error Resume Next不是最优解，它会掩盖错误，甚至让筛选逻辑失效。正确的做法是先筛选出目标列中实际存在的待选值，再用这个有效数组进行筛选，彻底避免报错。

修改后的完整代码 #

Sub FilterValidValues()
    Dim sh As Worksheet
    Dim targetCol As Range
    Dim uniqueVals As Collection
    Dim filterList As Variant
    Dim validFilter As Variant
    Dim i As Integer
    Dim cellVal As String
    
    Set sh = wbmain.Worksheets("depth")
    '定义目标列（第10列J列，从第2行开始到最后一行非空单元格）
    Set targetCol = sh.Range("J2:J" & sh.Range("J" & Rows.Count).End(xlUp).Row)
    
    '初始化存储目标列唯一值的集合
    Set uniqueVals = New Collection
    '提取目标列的唯一值
    On Error Resume Next '忽略重复值添加的错误
    For Each cell In targetCol
        cellVal = Trim(cell.Value)
        If cellVal <> "" Then
            uniqueVals.Add cellVal, Key:=cellVal
        End If
    Next cell
    On Error GoTo 0 '恢复错误捕获
    
    '原始待筛选值列表
    filterList = Array("A", "B", "G", "P", "L", "M", "C", "H", "K", "T", "W", "E", "N", "S", "D", "X", "U", "F")
    
    '生成仅包含目标列存在值的有效筛选数组
    ReDim validFilter(0 To 0)
    For i = LBound(filterList) To UBound(filterList)
        '检查当前筛选值是否在目标列的唯一值中
        On Error Resume Next
        uniqueVals(filterList(i))
        If Err.Number = 0 Then
            validFilter(UBound(validFilter)) = filterList(i)
            ReDim Preserve validFilter(0 To UBound(validFilter) + 1)
        End If
        On Error GoTo 0
    Next i
    '去掉最后一个空元素
    If UBound(validFilter) > 0 Then
        ReDim Preserve validFilter(0 To UBound(validFilter) - 1)
    Else
        '如果没有任何匹配值，取消筛选并退出
        sh.AutoFilterMode = False
        Exit Sub
    End If
    
    '执行筛选
    sh.Range("A1:J" & sh.Range("J" & Rows.Count).End(xlUp).Row).AutoFilter Field:=10, _
        Criteria1:=validFilter, Operator:=xlFilterValues
    
    '直接操作可见单元格，避免使用Select
    Dim visibleRange As Range
    On Error Resume Next '处理没有可见单元格的情况
    Set visibleRange = sh.Range("C1:I" & sh.Range("C" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    
    If Not visibleRange Is Nothing Then
        '这里写对可见单元格的操作，比如复制、赋值等
        '示例：visibleRange.Copy Destination:=wbmain.Worksheets("Result").Range("A1")
    Else
        MsgBox "没有匹配的可见数据"
    End If
End Sub

关键逻辑说明 #

• 提取目标列唯一值：遍历J列，用Collection存储不重复的值，避免重复判断。
• 生成有效筛选数组：对比原始筛选列表和目标列的唯一值，只保留实际存在的筛选值，确保AutoFilter不会因为不存在的值报错。
• 避免Select：直接操作Range对象，比Select更高效且不易出错。
• 异常处理：针对没有匹配值、没有可见单元格的情况做了处理，避免程序崩溃。

为什么不推荐用On Error Resume Next #

如果直接在AutoFilter前加On Error Resume Next，当遇到不存在的筛选值时，AutoFilter会直接跳过整个筛选逻辑（甚至可能保留之前的筛选状态），导致筛选结果不符合预期，而且你无法知道到底哪些值不存在，排查问题困难。

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