Excel VBA如何通过多字段映射表匹配两张工作表的表头并同步数据

先明确代码适配的表结构约定，你可以根据自己实际的行列位置调整对应参数：

• Mapping表：A_{C列为Sheet1侧的3列组合表头字段，F}G列为Sheet2侧对应的2列组合表头字段，映射规则从第2行开始
• Sheet1：第1、2、3行分别为三级组合表头的三个字段行，实际数据从第4行开始
• Sheet2：第1、2行分别为二级组合表头的两个字段行，实际数据从第3行开始

修改后的完整代码 #

Public Sub test()
    Application.ScreenUpdating = False
    Call stack("Sheet1", "Sheet2", "Mapping")
    Application.ScreenUpdating = True
End Sub

Public Sub stack(ByVal srcShtName As String, ByVal trgtShtName As String, ByVal mapShtName As String)
    Dim src As Worksheet, trgt As Worksheet, map As Worksheet
    Dim srcCol As Range, mapLastRow As Long, i As Long
    Dim srcKey As String, trgtKey1 As String, trgtKey2 As String
    Dim matchCol As Long
    
    ' 初始化工作表对象
    Set src = Worksheets(srcShtName)
    Set trgt = Worksheets(trgtShtName)
    Set map = Worksheets(mapShtName)
    
    ' 获取映射表最后一行行号
    mapLastRow = map.Cells(map.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历Sheet1所有有数据的表头列（以第3行表头为准）
    For Each srcCol In Intersect(src.Rows(3), src.UsedRange).SpecialCells(xlCellTypeConstants)
        ' 拼接Sheet1当前列的3级组合表头唯一键
        srcKey = src.Cells(1, srcCol.Column) & "|" & src.Cells(2, srcCol.Column) & "|" & src.Cells(3, srcCol.Column)
        
        ' 遍历映射表匹配对应规则
        trgtKey1 = ""
        trgtKey2 = ""
        For i = 2 To mapLastRow
            If map.Cells(i, "A") & "|" & map.Cells(i, "B") & "|" & map.Cells(i, "C") = srcKey Then
                ' 匹配到规则，取出对应Sheet2的2级组合表头
                trgtKey1 = map.Cells(i, "F")
                trgtKey2 = map.Cells(i, "G")
                Exit For
            End If
        Next i
        
        ' 没有匹配到规则则跳过当前列
        If trgtKey1 = "" Or trgtKey2 = "" Then GoTo nextCol
        
        ' 在Sheet2表头区域匹配对应的目标列
        For matchCol = 1 To trgt.UsedRange.Columns.Count
            If trgt.Cells(1, matchCol) = trgtKey1 And trgt.Cells(2, matchCol) = trgtKey2 Then
                ' 匹配到目标列，复制Sheet1数据粘贴到Sheet2对应位置
                src.Range(srcCol.Offset(1), src.Cells(src.Rows.Count, srcCol.Column).End(xlUp)).Copy
                trgt.Cells(3, matchCol).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False
                Exit For
            End If
        Next matchCol
        
nextCol:
    Next srcCol
End Sub

调整说明 #

• 如果你的映射表、Sheet1、Sheet2的表头行位置、列位置和约定不一致，直接修改代码中对应的行号、列号参数即可
• 代码中使用|作为拼接分隔符，如果你表头本身包含|字符，可以换成其他不会出现在表头里的特殊字符即可
• 粘贴默认使用值粘贴，如果需要保留格式可以修改PasteSpecial的参数

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