Excel多工作表RefId合并：重复ID同行列追加的VBA代码问题排查

以下是针对需求的完整VBA代码，可实现提取各工作表RefId对应整行数据到新表，重复RefId则将表头+数据追加到同一行的功能：

Sub CombineRefIdData()
    Dim ws As Worksheet
    Dim newWs As Worksheet
    Dim refDict As Object
    Dim lastRow As Long, lastCol As Long
    Dim refId As String
    Dim currentRow As Long, destCol As Long
    Dim i As Long, j As Long
    
    ' 用字典存储RefId对应的目标行号和已用列数
    Set refDict = CreateObject("Scripting.Dictionary")
    
    ' 创建/获取目标工作表
    On Error Resume Next
    Set newWs = ThisWorkbook.Worksheets("CombinedRefData")
    If Err.Number <> 0 Then
        Set newWs = ThisWorkbook.Worksheets.Add
        newWs.Name = "CombinedRefData"
    End If
    On Error GoTo 0
    
    ' 遍历所有工作表
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> newWs.Name Then
            lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
            lastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
            
            ' 遍历数据行（第2行开始，假设第1行是表头）
            For i = 2 To lastRow
                refId = Trim(ws.Cells(i, "A").Value) ' 假设RefId在A列，可自行修改列标
                If refId <> "" Then
                    If refDict.Exists(refId) Then
                        ' RefId已存在，获取目标行和空闲列位置
                        currentRow = refDict(refId)(0)
                        destCol = refDict(refId)(1) + 1
                        
                        ' 复制表头+数据到目标行右侧
                        ws.Cells(1, 1).Resize(1, lastCol).Copy newWs.Cells(currentRow, destCol)
                        ws.Cells(i, 1).Resize(1, lastCol).Copy newWs.Cells(currentRow, destCol)
                        
                        ' 更新字典中已用列数
                        refDict(refId) = Array(currentRow, destCol + lastCol - 1)
                    Else
                        ' RefId首次出现，写入新行
                        currentRow = newWs.Cells(newWs.Rows.Count, "A").End(xlUp).Row + 1
                        ws.Cells(1, 1).Resize(1, lastCol).Copy newWs.Cells(currentRow, 1)
                        ws.Cells(i, 1).Resize(1, lastCol).Copy newWs.Cells(currentRow, 1)
                        
                        ' 记录到字典
                        refDict(refId) = Array(currentRow, lastCol)
                    End If
                End If
            Next i
        End If
    Next ws
    
    ' 自动调整列宽
    newWs.UsedRange.Columns.AutoFit
    Set refDict = Nothing
    MsgBox "数据合并完成！"
End Sub

关键逻辑说明 #

• 字典存储机制：通过Scripting.Dictionary记录每个RefId对应的目标行号和已使用的最后一列，精准定位重复数据的追加位置。
• 数据复制规则：
  • 首次出现的RefId：在新表插入新行，先复制原表表头，再复制对应数据行。
  • 重复的RefId：找到对应行的空闲列，同时复制表头和数据行追加到右侧，保留原数据结构。
• 兼容性处理：自动判断目标工作表是否存在，避免重复创建。

自定义调整点 #

1. RefId列位置：若RefId不在A列，修改refId = Trim(ws.Cells(i, "A").Value)中的"A"为实际列标（如"B"、"C"）。
2. 表头行位置：若原表表头不在第1行，调整For i = 2 To lastRow中的"2"为表头行号+1。
3. 目标表名称：替换代码中所有"CombinedRefData"为你需要的工作表名称。

常见问题排查 #

• 若RefId匹配异常：检查原表中RefId是否有多余空格，可在Trim()后添加Replace(refId, " ", "")进一步清理。
• 若宏无法运行：确保Excel已启用宏功能（文件→选项→信任中心→信任中心设置→宏设置）。
• 若表头结构不一致：代码支持不同工作表表头列数不同的场景，会按各自表头结构追加数据。

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