VBA提取筛选列表值后重新筛选失效，仅匹配首个值问题排查

核心问题 #

你的代码存在两个关键问题：

• 筛选后的可见单元格属于不连续区域，直接用.Value赋值给Criteria时，得到的不是连续数组，而是包含多个子数组的变体类型。Application.Transpose无法正确解析这种结构，最终只有第一个区域的首个值被用于筛选。
• MsgBox (Criteria) 仅能显示数组的第一个元素，这会让你误以为只捕获了单个值，但本质是数组结构不符合AutoFilter的参数要求。

修复后的代码 #

Dim LR As Long, ws As Worksheet
Dim Criteria As Variant
Dim cell As Range
Dim tempList As Collection

Set ws = ActiveSheet
Set tempList = New Collection

' 遍历筛选后的F列可见单元格，收集所有目标值
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
For Each cell In ws.Range("F2:F" & LR).SpecialCells(xlCellTypeVisible)
    tempList.Add cell.Value
Next cell

' 将集合转换为AutoFilter可识别的一维数组
ReDim Criteria(1 To tempList.Count)
For i = 1 To tempList.Count
    Criteria(i) = tempList(i)
Next i

' 取消原有筛选
ws.Cells.AutoFilter

' 重新获取总行数并执行筛选
LR = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A1:BY" & LR).AutoFilter Field:=6, Criteria1:=Criteria, Operator:=xlFilterValues

关键修改说明 #

• 用Collection收集可见单元格的值：无论单元格区域是否连续，都能完整捕获所有需要的筛选条件，避免不连续区域导致的数组结构异常。
• 转换为一维数组：AutoFilter搭配xlFilterValues时，要求Criteria1是一维数组，这样才能正确匹配所有目标值。
• 移除无效的Transpose操作：原代码的转置操作对不连续区域的数组无效，修复后无需再使用。

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