VBA:合并多行到同一列

Sub MergeRowsBasedOnColumnA()
    Dim ws As Worksheet
    Dim rng As Range
    Dim r As Long
    Dim lastRow As Long
    Dim col As Integer
    Dim j As Integer: j = 1
    
 
    Set ws = ThisWorkbook.Sheets("Sheet1") '将"Sheet1"更改为你的工作表名称
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
 
    Application.ScreenUpdating = False
 
    For r = lastRow To 2 Step -1
        If ws.Cells(r, "A").Value = ws.Cells(r - 1, "A").Value Then
            '从后往前
            '下一行的从B开始到后面的所有不空的列的值，都复制到上一列的最后
            Set startCell = ws.Cells(r, "B") '设置起始单元格
            Set endCell = startCell.End(xlToRight)
            col = ws.Cells(r - 1, 1).End(xlToRight).Column
            '遍历并打印值
            j = 1
            For i = startCell.Column To endCell.Column
                ws.Cells(r - 1, col + j).Value = ws.Cells(r, i).Value
                j = j + 1
            Next i
            
            
            
            ws.Rows(r).Delete
        End If
    Next r
 
    Application.ScreenUpdating = True
End Sub