VBA循环中AutoFilter累积旧筛选条件问题求助

你的问题根源很明确：每次循环时你都在用包含所有历史值的数组作为筛选条件，而不是仅用当前行的值。原代码里的ary数组会随着循环不断存入之前所有单元格的值，再加上Operator:=xlFilterValues参数，就会让筛选条件累积起来，导致第二次循环同时筛选A1和A2的值，第三次则是A1+A2+A3，以此类推。

下面是修复后的代码，同时我还优化了代码的稳定性和效率（去掉了容易出问题的Select/Activate）：

Sub FilterAndCopy()
    Dim wsList As Worksheet
    Dim wsIngredients As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim currentValue As String
    Dim newWB As Workbook
    
    ' 直接绑定工作表对象，避免依赖激活状态
    Set wsList = Workbooks("file.xlsm").Sheets("list")
    Set wsIngredients = Workbooks("file.xlsm").Sheets("ingredients")
    
    ' 获取list表A列最后一行
    lastRow = wsList.Cells(wsList.Rows.Count, "A").End(xlUp).Row
    
    For i = 1 To lastRow
        ' 取出当前行A列的值
        currentValue = wsList.Cells(i, 1).Value
        
        ' 关键：先清除之前的筛选状态，确保每次筛选从零开始
        If wsIngredients.AutoFilterMode Then
            wsIngredients.AutoFilterMode = False
        End If
        
        ' 仅用当前值做筛选（不需要数组和xlFilterValues，因为是单个值）
        wsIngredients.Range("$A$1:$E$1451").AutoFilter Field:=1, Criteria1:=currentValue
        
        ' 复制筛选后的可见区域到新工作簿
        Set newWB = Workbooks.Add
        wsIngredients.Range("$A$1:$E$1451").SpecialCells(xlCellTypeVisible).Copy _
            Destination:=newWB.Sheets(1).Range("A1")
        
        Application.CutCopyMode = False
        
        ' 如果你需要自动保存新文件，可以取消下面两行注释
        ' newWB.SaveAs Filename:="C:\" & currentValue & ".xlsx"
        ' newWB.Close SaveChanges:=True
    Next i
    
    ' 循环结束后清除ingredients表的筛选
    wsIngredients.AutoFilterMode = False
End Sub

关键修改说明： #

• 清除旧筛选：每次循环开始前强制清除之前的筛选状态，保证每次筛选都是从无筛选的干净状态开始，不会继承之前的条件。
• 单个值筛选：直接使用当前行的currentValue作为筛选条件，不再用数组和xlFilterValues（这个参数是给多值筛选用的，你这里单值完全不需要）。
• 去掉Select/Activate：直接通过工作表对象操作单元格，避免因当前激活的工作表变化导致代码出错，这是VBA编写的最佳实践之一。
• 复制可见区域：用SpecialCells(xlCellTypeVisible)只复制筛选后显示的行，避免复制整列的空行，更高效。

原代码里的ary数组其实完全是多余的，你不需要把所有值先存起来再循环，直接在循环里取当前值即可，这样也避免了数组累积值的问题。

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