Excel VBA实现行合并与数据合并需求

需求说明 #

• Sheet 1（原始数据）：包含重复X值，每个X对应多个独立的Y值

Column X            Column Y
1                           A
1                           B
1                           C
2                           A
3                           D
3                           E

• Sheet 2（目标输出）：将同一X对应的所有Y值用|拼接，每行保留唯一X值

Column X            Column Y
1   A|B|C
2   A
3   D|E

现有代码 #

目前仅完成表头复制功能，代码如下：

Sub CommandButton1_Click()
    Dim xInitialData As Worksheet
    Dim xNormalized As Worksheet
    Dim Val As Variant
    
    Set xPopulatedData = ActiveWorkbook.Sheets("Sheet 1")
    nInitRows = xPopulatedData.Cells(xPopulatedData.Rows.Count, 1).End(xlUp).Row
    
    Set xNormalized = ActiveWorkbook.Sheets("Sheet 2")
    xNormalized.Cells.Clear
    xNormalized.Cells(1, 1) = "Column X"
    xNormalized.Cells(1, 2) = "Column Y"
End Sub

完整实现代码 #

在现有代码基础上添加数据合并逻辑，完整代码如下：

Sub CommandButton1_Click()
    Dim xPopulatedData As Worksheet
    Dim xNormalized As Worksheet
    Dim dataDict As Object
    Dim i As Long
    Dim currentX As Variant
    Dim currentY As String
    Dim outputRow As Long
    
    ' 初始化工作表与字典对象
    Set xPopulatedData = ActiveWorkbook.Sheets("Sheet 1")
    Set xNormalized = ActiveWorkbook.Sheets("Sheet 2")
    Set dataDict = CreateObject("Scripting.Dictionary")
    
    ' 获取原始数据总行数
    nInitRows = xPopulatedData.Cells(xPopulatedData.Rows.Count, 1).End(xlUp).Row
    
    ' 清空目标表并写入表头
    xNormalized.Cells.Clear
    xNormalized.Cells(1, 1) = "Column X"
    xNormalized.Cells(1, 2) = "Column Y"
    
    ' 遍历原始数据，用字典合并同X值的Y内容
    For i = 2 To nInitRows ' 跳过表头从第2行开始
        currentX = xPopulatedData.Cells(i, 1).Value
        currentY = xPopulatedData.Cells(i, 2).Value
        
        If dataDict.Exists(currentX) Then
            ' X已存在，追加Y值（用|分隔）
            dataDict(currentX) = dataDict(currentX) & "|" & currentY
        Else
            ' X不存在，新增字典条目
            dataDict(currentX) = currentY
        End If
    Next i
    
    ' 将字典数据写入目标工作表
    outputRow = 2 ' 从第2行开始写入数据
    For Each currentX In dataDict.Keys
        xNormalized.Cells(outputRow, 1).Value = currentX
        xNormalized.Cells(outputRow, 2).Value = dataDict(currentX)
        outputRow = outputRow + 1
    Next currentX
End Sub

关键逻辑说明 #

• 借助Scripting.Dictionary的键唯一性，自动实现X值的去重
• 遍历原始数据时，动态拼接同一X对应的Y值，用|作为分隔符
• 最后遍历字典的键值对，将合并结果批量写入Sheet2

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