将多行合并为一行

Question

我正在尝试将多行数据合并为一行。A 列包含分组所依据的值 - A 列值匹配的行将合并为一行。我的范围从 A 列延伸到 X 列，所以我需要一行匹配的数据从 Y 列开始。

例子：

╔══════╦═══╦═══╗
║ 1001 ║ A ║ C ║
║ 1001 ║ B ║ D ║
║ 1002 ║ A ║ E ║
║ 1002 ║ B ║ F ║
║ 1002 ║ C ║ G ║
╚══════╩═══╩═══╝

期望结果：

╔══════╦═══╦═══╦═══╦═══╦═══╦═══╗
║ 1001 ║ A ║ C ║ B ║ D ║   ║   ║
║ 1002 ║ A ║ E ║ B ║ F ║ C ║ G ║
╚══════╩═══╩═══╩═══╩═══╩═══╩═══╝

我目前使用的 VBA 代码不会获取匹配行的全部内容。它仅获取第二列中的数据并将其向上移动。

VBA 代码：

Sub Mergeitems()

    Dim cl As Range
    Dim rw As Range

    Set rw = ActiveCell

    Do While rw <> ""
        ' for each row in data set
        '   find first empty cell on row
        Set cl = rw.Offset(0, 1)
        Do While cl <> ""
            Set cl = cl.Offset(0, 1)
        Loop

        ' if next row needs to be processed...
        Do While rw = rw.Offset(1, 0)
            cl = rw.Offset(1, 1)       ' move the data
            Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
            rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data
        Loop

        ' next row
        Set rw = rw.Offset(1, 0)
    Loop
End Sub

Answer 1

我可能会用完全不同的宏来解决您的一般问题（合并行），但您可能想在代码中更改以下几行：

cl = rw.Offset(1, 1)       ' move the data
Set cl = cl.Offset(0, 1)   ' update pointer to next blank cell
rw.Offset(1, 0).EntireRow.Delete xlShiftUp   ' delete old data

尝试用这个替换它们：

i = 1
Do While rw.Offset(1, i) <> "" 
    cl = rw.Offset(1, i)      
    Set cl = cl.Offset(0, 1)  
    i = i + 1
Loop
rw.Offset(1, 0).EntireRow.Delete xlShiftUp  'delete old data

结果：