Question

我有一个类似于以下的数据集：

Example data

我想将数据转换为多个列，其中删除重复的ID（第1列），并将所有其他数据合并为跨列的单个行。

我从另一个线程尝试了以下代码：

Convert columns with multiple rows of data to rows with multiple columns in Excel.

但是，这导致第二列数据也跨行合并，其中行中存在重复项。

例如，上表将显示为

Current result

我需要修改代码，使其仅删除第1列中的重复数据，并将其余数据分布到各列中。

我希望数据结束如下：

Desired result

以下是我正在使用的代码：

Sub ConsolidateRows_SpreadAcross()

Dim lastRow As Long, i As Long, j As Long
Dim colMatch As Variant, colConcat As Variant

application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes

lastRow = range("A" & Rows.Count).End(xlUp).Row 'get last row

For i = lastRow To 2 Step -1

    If Cells(i, 2) = Cells(i - 1, 2) Then
        range(Cells(i, 3), Cells(i, Columns.Count).End(xlToLeft)).Copy Cells(i - 1, Columns.Count).End(xlToLeft).Offset(, 1)
        Rows(i).Delete
    Else
        If Cells(i, 1) = Cells(i - 1, 1) Then
            range(Cells(i, 2), Cells(i, Columns.Count).End(xlToLeft)).Copy _
                Cells(i - 1, Columns.Count).End(xlToLeft).Offset(, 1)
            Rows(i).Delete
        End If
    End If

Next

application.ScreenUpdating = True 'reenable ScreenUpdating

End Sub

任何帮助将不胜感激。

Answer 1

使用当前模式的数据，您无需同时检查A列和B列。

Sub ConsolidateRows_SpreadAcross()

    Dim i As Long, j As Long
    Dim colMatch As Variant, colConcat As Variant

    Application.ScreenUpdating = False 'disable ScreenUpdating to avoid screen flashes

    With Worksheets("sheet15")

        For i = .Cells(.Rows.Count, "A").End(xlUp).Row To 2 Step -1

            If .Cells(i, 1) = Cells(i - 1, 1) Then
                .Range(.Cells(i, 3), .Cells(i, .Columns.Count).End(xlToLeft)).Copy _
                  Destination:=.Cells(i - 1, .Columns.Count).End(xlToLeft).Offset(0, 1)
                .Rows(i).Delete
            End If

        Next i

        .Cells(1, "C").Resize(1, .Cells(1, 1).CurrentRegion.Columns.Count - 2) = "data"

    End With

    Application.ScreenUpdating = True 'reenable ScreenUpdating

End Sub

将包含多行数据的列转换为包含多列的行，并删除重复的参考数字

1 个答案: