将不同的行合并为一行而不丢失数据 - VBA 代码

Question

我有以下数据集，我想使用 VBA 将不同的行合并为一个，而不丢失数据。我尝试了不同的代码，但它们只保留第一行的信息。

我现在拥有的

我想要实现什么

如果有人能阐明这一点，我将不胜感激 谢谢， 西尔维娅

这是我使用的代码：

Sub MergeRows()

    Dim ws As Worksheet
    Dim i As Long, j As Long, lastRow As Long
    Dim target As String

    'Set the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet 1")

    'Find the last row
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    'Loop through each row (except the first one)
    For i = 2 To lastRow
        'Set the target column value
        target = ws.Cells(i, "G").Value

        'Loop backwards from the current row to the first row
        For j = i To 2 Step -1
            'Check if the target column value is the same as in the current row
            If ws.Cells(j, "G").Value = target Then
                'If the target column value is the same, concatenate the values of the other columns
                ws.Cells(i, "C").Value = ws.Cells(i, "C").Value & ", " & ws.Cells(j, "C").Value
                ws.Cells(i, "D").Value = ws.Cells(i, "D").Value & ", " & ws.Cells(j, "D").Value
                'Delete the merged row
                ws.Rows(j).Delete
            End If
        Next j
    Next i
End Sub

但是当我运行它时，什么也没发生。

Answer 1

试试这个子

Sub range_merge()

Application.DisplayAlerts = False
lastcol = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To lastcol
Cells(1, i) = Cells(1, i) & Chr(10) & Cells(2, i)
Range(Cells(1, i), Cells(2, i)).Merge
Next i
Application.DisplayAlerts = True

End Sub