Excel VBA循环跨工作表复制合并数据问题咨询

核心逻辑说明 #

直接用行号变量做双层循环遍历，不需要依赖选中范围或者复杂的Range偏移操作，稳定性更高，适配你150*50的笛卡尔积合并需求：

• 外层循环遍历WS1的所有待合并行（共150行，起始行36）
• 内层循环遍历WS2的所有待合并行（共50行，起始行1）
• 每一轮内层循环完成后自动进入WS1下一行的遍历，自动计算WS3的写入行号，不需要手动维护偏移量

完整代码示例 #

Sub MergeWorksheetsData()
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim ws1_start_row As Long, ws2_start_row As Long, ws3_current_row As Long
    Dim i As Long, j As Long, match_col As Long
    Dim match_value As Variant
    
    ' 定义工作表对象，可根据实际表名修改
    Set ws1 = ThisWorkbook.Worksheets("WS1")
    Set ws2 = ThisWorkbook.Worksheets("WS2")
    ' 新建结果工作表WS3
    Set ws3 = ThisWorkbook.Worksheets.Add
    ws3.Name = "合并结果"
    
    ' 配置起始行参数
    ws1_start_row = 36
    ws2_start_row = 1
    ws3_current_row = 1
    
    ' 外层循环：遍历WS1共150行
    For i = ws1_start_row To ws1_start_row + 149
        ' 内层循环：遍历WS2共50行
        For j = ws2_start_row To ws2_start_row + 49
            ' 复制WS1当前行A到D列到WS3
            ws3.Range("A" & ws3_current_row & ":D" & ws3_current_row).Value = ws1.Range("A" & i & ":D" & i).Value
            ' 复制WS2当前行A到H列到WS3
            ws3.Range("E" & ws3_current_row & ":L" & ws3_current_row).Value = ws2.Range("A" & j & ":H" & j).Value
            
            ' 匹配WS1第34行对应列提取数值
            match_value = ws3.Range("L" & ws3_current_row).Value
            On Error Resume Next ' 防止匹配不到时报错，可根据需要调整错误处理逻辑
            match_col = WorksheetFunction.Match(match_value, ws1.Rows(34), 0)
            On Error GoTo 0
            
            If match_col > 0 Then
                ' 此处默认将匹配到的数值写入WS3的M列，可根据需要调整目标列
                ws3.Range("M" & ws3_current_row).Value = ws1.Cells(i, match_col).Value
            End If
            
            ' WS3写入行号+1
            ws3_current_row = ws3_current_row + 1
            ' 重置匹配列标记
            match_col = 0
        Next j
    Next i
    
    ' 可选：自动调整列宽
    ws3.UsedRange.EntireColumn.AutoFit
    MsgBox "合并完成，共生成" & ws3_current_row - 1 & "行数据"
End Sub

注意事项 #

• 代码中工作表名称、匹配后数值的写入列可根据你的实际需求修改对应参数
• 如果WS1第34行的匹配值存在重复，默认会匹配第一个符合条件的列，如有重复值特殊匹配需求可自行调整匹配逻辑
• 直接操作单元格值赋值的方式比复制粘贴执行效率更高，7500行数据可秒级完成

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