☰

合并重复项并合并到 Excel 2007 的行中

tag-icon • tag-icon microsoft-excel microsoft-excel-2007
合并重复项并合并到 Excel 2007 的行中

我希望执行以下操作，但不确定如何做...可以帮忙吗？

原来的

Column1   Column2
TitleA       123
TitleA       345
TitleB       888
TitleC       567
TitleC       789

后

Column1   Column2
TitleA       123   345
TitleB       888
TitleC       567   789

如果有人能帮助提供建议我将不胜感激:)

答案1

您可以从我拥有的这个旧宏开始，并尝试对其进行自定义以满足您的需求，如果您需要任何指导，只需询问即可。

Sub ConcatenateAcrossColumns()

Dim data, numrows As Long, result, i As Long, n As Long

'turn off screen update
Application.ScreenUpdating = 0

'check if the data on the sheet start where the code expects it
If Range("a1") = "" Then Exit Sub

'define data range
With Range("a1", Cells(Rows.Count, "a").End(xlUp)).Resize(, 2)

    'sort data range by A1
    .Sort key1:=Range("a1"), Header:=xlNo
    'take data to array
    data = .Value
    'setting variable value equal to number of rows in array
    numrows = UBound(data)
    'creating result array
    ReDim result(1 To numrows, 1 To 1)

    'start loop from 1 row to the last row of array
    For i = 1 To numrows
    'taking first animal name to a variable
    temp = data(i, 1)
    'put number of the animal to result array
    result(i, 1) = result(i, 1) & data(i, 2)
    'loop until value of temp not equals current animal - ex.: cat <> dog
    For n = i + 1 To numrows
        'if cat = cat write it's corresponding value from the second column to result array
        If data(n, 1) = temp Then result(i, 1) = result(i, 1) & "," & data(n, 2) Else Exit For

    Next
    'going 1 row backward
    i = n - 1

    Next
    'output result array to the sheet
    .Offset(, 2).Resize(, 1) = result

End With

End Sub

相关内容