如何编写VBA循环批量处理多列筛选条件并复制结果

需求说明 #

• 自动处理schedule工作表O列所有筛选条件
• 支持后续扩展为依次处理P列等更多列的筛选条件，替代逐个编写独立宏的方式

原宏存在的问题 #

原有的FILTER1st和FILTER2nd宏包含大量重复代码，仅筛选单元格位置和粘贴起始行有差异，无法批量处理多单元格/多列的筛选需求，后续维护成本高。

优化后的可扩展宏代码 #

Sub BatchFilterAndCopy()
    Dim wsSchedule As Worksheet
    Dim wsSOP As Worksheet
    Dim wsTemp As Worksheet
    Dim filterCols As Variant
    Dim filterCol As Variant
    Dim lastRow As Long
    Dim cell As Range
    Dim pasteRow As Long
    
    ' 初始化工作表对象，避免使用Select/Activate提升运行效率
    Set wsSchedule = ThisWorkbook.Sheets("schedule")
    Set wsSOP = ThisWorkbook.Sheets("SOP")
    Set wsTemp = ThisWorkbook.Sheets("temp")
    
    ' 定义需要处理的筛选条件列，直接添加列名即可扩展（示例：Array("O", "P")）
    filterCols = Array("O")
    
    ' 遍历每个需要处理的筛选条件列
    For Each filterCol In filterCols
        ' 获取当前列最后一行非空单元格的行号
        lastRow = wsSchedule.Cells(wsSchedule.Rows.Count, filterCol).End(xlUp).Row
        
        ' 遍历当前列的每个筛选条件（从第3行开始）
        For Each cell In wsSchedule.Range(filterCol & "3:" & filterCol & lastRow)
            ' 跳过空单元格
            If cell.Value <> "" Then
                ' 清除SOP工作表的现有筛选状态
                wsSOP.AutoFilterMode = False
                
                ' 在SOP工作表第4列应用当前筛选条件
                wsSOP.Range("A1:Z1").AutoFilter Field:=4, Criteria1:=cell.Value
                
                ' 定位筛选后的数据区域（从B2开始）
                With wsSOP.Range("B2", wsSOP.Cells(wsSOP.Rows.Count, "B").End(xlUp))
                    If .Row >= 2 Then ' 确保存在筛选结果
                        ' 获取temp工作表B列的下一个空行
                        pasteRow = wsTemp.Cells(wsTemp.Rows.Count, "B").End(xlUp).Row
                        If pasteRow < 3 Then pasteRow = 3 ' 保证从B3开始粘贴
                        
                        ' 复制筛选结果到temp工作表的对应位置
                        .Resize(, wsSOP.Cells(1, wsSOP.Columns.Count).End(xlToLeft).Column - 1).Copy _
                            Destination:=wsTemp.Range("B" & pasteRow + 1)
                    End If
                End With
            End If
        Next cell
    Next filterCol
    
    ' 清理SOP工作表的筛选状态
    wsSOP.AutoFilterMode = False
    
    ' 释放对象资源
    Set wsSchedule = Nothing
    Set wsSOP = Nothing
    Set wsTemp = Nothing
    
    MsgBox "批量筛选复制完成！"
End Sub

代码核心优势 #

• 高扩展性：要新增处理列（如P列），仅需修改filterCols = Array("O")为Array("O", "P")即可
• 高效稳定：摒弃Select/Activate操作，直接通过工作表对象读写数据，运行速度更快且不易出错
• 健壮性强：自动跳过空筛选条件，判断筛选结果是否存在，避免无效复制操作
• 自适应定位：自动识别各工作表的最后一行，无需手动固定单元格位置

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