需求：编写VBA实现多工作表数据筛选匹配与批量复制

下面是满足需求的VBA代码，直接复制到Excel的VBA编辑器中即可运行：

Sub ProcessData()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long, targetRow As Long
    Dim i As Long, matchRange As Range
    
    ' 绑定工作表对象
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    Set ws3 = ThisWorkbook.Sheets("Sheet3")
    
    ' 清空Sheet3原有数据
    ws3.Cells.Clear
    
    targetRow = 1 ' Sheet3的起始写入行
    
    ' 获取Sheet1有效数据的最后一行
    lastRow1 = ws1.Cells(ws1.Rows.Count, "C").End(xlUp).Row
    
    ' 遍历Sheet1数据行（假设第1行是表头，从第2行开始）
    For i = 2 To lastRow1
        ' 检查J列或K列数值是否小于3.5，先判断是否为数值避免报错
        If (IsNumeric(ws1.Cells(i, "J").Value) And ws1.Cells(i, "J").Value < 3.5) Or _
           (IsNumeric(ws1.Cells(i, "K").Value) And ws1.Cells(i, "K").Value < 3.5) Then
           
            ' 复制Sheet1该行指定单元格到Sheet3的A列区域（示例复制A-L列，可按需调整范围）
            ws1.Range("A" & i & ":L" & i).Copy Destination:=ws3.Range("A" & targetRow)
            
            ' 在Sheet2中查找匹配的起始里程标（精确匹配C列内容）
            lastRow2 = ws2.Cells(ws2.Rows.Count, "C").End(xlUp).Row
            Set matchRange = ws2.Range("C2:C" & lastRow2).Find(What:=ws1.Cells(i, "C").Value, LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not matchRange Is Nothing Then
                ' 复制匹配行下方连续10行到Sheet3的M列区域
                If matchRange.Row + 10 <= lastRow2 Then
                    ws2.Range("A" & matchRange.Row + 1 & ":L" & matchRange.Row + 10).Copy Destination:=ws3.Range("M" & targetRow)
                Else
                    ' 若剩余行数不足10行，复制所有剩余行
                    ws2.Range("A" & matchRange.Row + 1 & ":L" & lastRow2).Copy Destination:=ws3.Range("M" & targetRow)
                End If
            End If
            
            targetRow = targetRow + 1 ' 下移目标行，保证无空行
        End If
    Next i
    
    Application.CutCopyMode = False ' 清除剪贴板，避免弹窗提示
    MsgBox "数据处理完成！", vbInformation
End Sub

代码关键细节说明 #

• 工作表绑定：提前绑定三个工作表对象，减少重复引用名称的出错概率
• 数值校验：加入IsNumeric判断，避免非数值单元格触发报错
• 灵活复制范围：示例中复制Sheet1的A-L列到Sheet3，你可以根据实际需求修改ws1.Range("A" & i & ":L" & i)的单元格范围
• 容错处理：当Sheet2中匹配行下方不足10行时，自动复制所有剩余行，避免越界错误
• 无空行保证：通过targetRow变量逐行累加，确保每个符合条件的实例连续排列

使用步骤 #

1. 打开目标Excel文件，按下Alt + F11打开VBA编辑器
2. 在左侧工程窗口右键点击工作簿，选择「插入」→「模块」
3. 将上述代码粘贴到模块窗口中
4. 按下F5运行代码，或回到Excel界面通过「开发工具」→「宏」选择ProcessData执行

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