VBA如何将选中单元格内容作为AutoFilter筛选条件实现多值筛选

核心问题原因 #

你代码的错误点在于将筛选条件拼接为了单个字符串，AutoFilter使用Operator:=xlFilterValues参数时，要求Criteria1必须传入一维变体/字符串数组，而非拼接的单值字符串，这也是你写死Array参数时可以正常运行的原因。
你之前尝试转置区域失效的原因是：直接将多单元格区域赋值得到的是二维数组，xlFilterValues仅支持一维数组作为入参，转置操作如果没有完成二维到一维的降级，就无法生效。

修正后代码 #

Sub 按选中值筛选()
    Dim cel As Range
    Dim selectedRange As Range
    Dim arr As Variant
    Dim dict As Object
    Dim x As Long, lastrow As Long, i As Long
    
    ' 后期绑定字典，无需额外引用
    Set dict = CreateObject("Scripting.Dictionary")
    Set selectedRange = Application.Selection
    
    ' 判断是否选中了有效单元格
    If selectedRange Is Nothing Then Exit Sub
    If selectedRange.Cells.Count < 1 Then Exit Sub
    
    ' 遍历选中值存入字典去重，跳过空单元格
    For Each cel In selectedRange.Cells
        If Trim(cel.Value) <> "" And Not dict.exists(cel.Value) Then
            dict.Add CStr(cel.Value), cel.Value ' 统一转成字符串匹配，可根据需求调整
        End If
    Next cel
    
    ' 没有有效筛选值直接退出
    If dict.Count = 0 Then Exit Sub
    
    ' 转成符合要求的一维数组
    ReDim arr(0 To dict.Count - 1)
    For i = 0 To dict.Count - 1
        arr(i) = dict.keys()(i)
    Next i
    
    x = ActiveCell.Column
    lastrow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 筛选区域如果不是从A列起始，Field参数需要调整为 x - 筛选区域起始列号 +1
    ActiveSheet.Range("$A$10:$DV" & lastrow).AutoFilter Field:=x, Criteria1:=arr, Operator:=xlFilterValues
End Sub

注意事项 #

• 如果你需要筛选数字类型的列，把代码中CStr(cel.Value)的转换逻辑删掉即可，避免类型不匹配导致筛选失效
• 如果你的筛选区域不是从A列开始，需要调整Field参数的计算规则，比如筛选区域从C列开始，C是第3列，那么Field的值应为x - 3 + 1

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