Excel VBA实现取消勾选筛选以排除指定值

当你需要在值数量未知的列中筛选排除特定值（比如10和11）时，硬编码保留值的方式（像你当前用的Criteria1:=Array("0", "1", "2", "3", "4")）不够灵活。下面是动态获取列中所有唯一值并排除目标项的解决方案：

实现思路 #

1. 获取目标列的所有非空唯一值，避免重复处理
2. 从唯一值集合中移除需要排除的项
3. 使用处理后的结果数组应用筛选

完整代码 #

Sub FilterExcludeValues()
    Dim ws As Worksheet
    Dim filterRange As Range
    Dim targetCol As Integer
    Dim excludeValues As Variant
    Dim uniqueValues As Variant
    Dim filteredValues As Variant
    Dim i As Integer, j As Integer, k As Integer
    
    ' 配置参数
    Set ws = ActiveSheet
    Set filterRange = ws.Range("$A$12:$AM$31570")
    targetCol = 16 ' 要筛选的列序号（对应原代码中的Field:=16）
    excludeValues = Array("10", "11") ' 需排除的值，注意与列中数据类型匹配
    
    ' 清除现有筛选（如果存在）
    If ws.AutoFilterMode Then filterRange.AutoFilter
    
    ' 获取目标列的所有非空唯一值
    uniqueValues = ws.Range(ws.Cells(12, targetCol), ws.Cells(filterRange.Rows.Count + 11, targetCol)).Value
    uniqueValues = GetUniqueValues(uniqueValues)
    
    ' 构建排除后的筛选值数组
    ReDim filteredValues(0 To UBound(uniqueValues))
    k = 0
    For i = LBound(uniqueValues) To UBound(uniqueValues)
        Dim isExcluded As Boolean
        isExcluded = False
        ' 检查当前值是否在排除列表中
        For j = LBound(excludeValues) To UBound(excludeValues)
            If uniqueValues(i) = excludeValues(j) Then
                isExcluded = True
                Exit For
            End If
        Next j
        ' 非排除值加入结果数组
        If Not isExcluded Then
            filteredValues(k) = uniqueValues(i)
            k = k + 1
        End If
    Next i
    ReDim Preserve filteredValues(0 To k - 1)
    
    ' 应用筛选
    If UBound(filteredValues) >= 0 Then
        filterRange.AutoFilter Field:=targetCol, Criteria1:=filteredValues, Operator:=xlFilterValues
    Else
        MsgBox "所有值均被排除，将显示全部数据"
    End If
End Sub

' 辅助函数：从二维单元格数组中提取唯一值，返回一维数组
Function GetUniqueValues(inputArr As Variant) As Variant
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")
    Dim i As Integer
    
    For i = LBound(inputArr, 1) To UBound(inputArr, 1)
        If inputArr(i, 1) <> "" Then ' 跳过空单元格
            dict(inputArr(i, 1)) = vbNullString
        End If
    Next i
    
    GetUniqueValues = dict.Keys
End Function

关键注意点 #

• 数据类型匹配：如果目标列是数字格式，需将excludeValues改为Array(10, 11)；如果是文本格式则保留Array("10", "11")，否则筛选会失效
• 空值处理：辅助函数会自动跳过空单元格，避免筛选时出现空值选项
• 边界情况：如果所有值都被排除，代码会弹出提示并清除筛选，显示全部数据

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