如何用VBA实现Excel中同一编号对应多行列数据的合并？

我有一组Excel数据，列A为编号，列B和列C中每个编号对应多行数据。希望将每列的数据合并，使每个编号仅占一行。列A中每个编号之间的行数不固定，曾手动使用TEXTJOIN函数合并单元格，但无法指定范围并批量处理整个文档，请问能否用VBA实现该操作？

原始数据 #

期望结果 #

VBA实现代码 #

打开Excel，按下Alt + F11打开VBA编辑器，右键点击目标工作簿→插入→模块，粘贴以下代码：

Sub MergeSameIDRows()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, currentIDRow As Long
    Dim bText As String, cText As String
    
    ' 指定要处理的工作表，可修改为具体表名如Sheets("Sheet1")
    Set ws = ActiveSheet
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    currentIDRow = 1 ' 记录当前编号所在行
    
    For i = 2 To lastRow
        ' 当前行A列为空，属于上一个编号，累积B、C列内容
        If ws.Cells(i, "A").Value = "" Then
            bText = bText & " " & ws.Cells(i, "B").Value
            cText = cText & " " & ws.Cells(i, "C").Value
        Else
            ' 遇到新编号，把累积内容写入上一个编号的对应列
            ws.Cells(currentIDRow, "B").Value = Trim(ws.Cells(currentIDRow, "B").Value & bText)
            ws.Cells(currentIDRow, "C").Value = Trim(ws.Cells(currentIDRow, "C").Value & cText)
            
            ' 重置缓存，更新当前编号行
            bText = ""
            cText = ""
            currentIDRow = i
        End If
    Next i
    
    ' 处理最后一个编号的剩余内容
    ws.Cells(currentIDRow, "B").Value = Trim(ws.Cells(currentIDRow, "B").Value & bText)
    ws.Cells(currentIDRow, "C").Value = Trim(ws.Cells(currentIDRow, "C").Value & cText)
    
    ' 删除空编号的冗余行
    For i = lastRow To 2 Step -1
        If ws.Cells(i, "A").Value = "" Then
            ws.Rows(i).Delete
        End If
    Next i
    
    MsgBox "合并完成！", vbInformation
End Sub

使用说明 #

1. 若数据不在当前活动工作表，修改代码中Set ws = ActiveSheet为具体表名，比如Set ws = Sheets("数据清单")
2. 运行代码前建议备份原始数据，避免意外
3. 代码会自动合并同一编号下的B、C列内容（用空格分隔），并删除多余的空编号行

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