Excel VBA - 基于重复搜索合并单元格

Question

我需要帮助编写VBA代码以在一列中查找重复值，然后根据该搜索合并单元格。 E.g：

France  6216    EDE 009789  Company A
France  6216    EDF 009790  Company A
France  6216    EDG 009791  Company A
Germany 6216    EDH 009792  Company B

变为：

France  6216    EDE EDF EDG 009789 009790 009791    Company A
Germany 6216    EDH         009792                  Company B

它在一个大型电子表格中，其中一些欺骗将有两个，但有些可能多达八个。 任何人都可以帮助我吗？

有任何问题，请告诉我。

非常感谢！

Answer 1

试试这个宏，

Sub removeDupes()
    Dim i As Long, j As Long, k As Long
    Columns("A:E").Sort key1:=Range("A2"), order1:=xlAscending, Header:=xlYes
    Sheets.Add.Name = "newSheet"
    Sheets("newSheet").Cells(1, 1) = Cells(2, 1)
    Sheets("newSheet").Cells(1, 2) = Cells(2, 2)
    Sheets("newSheet").Cells(1, 3) = Cells(2, 3)
    Sheets("newSheet").Cells(1, 150) = Cells(2, 4)
    Sheets("newSheet").Cells(1, 255) = Cells(2, 5)
    j = 1
    k = 1
    For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i + 1, 1) = Cells(i, 1) Then
            Sheets("newSheet").Cells(j, 3 + k) = Cells(i + 1, 3)
            Sheets("newSheet").Cells(j, 150 + k) = Cells(i + 1, 4)
            k = k + 1
        Else
            j = j + 1
            Sheets("newSheet").Cells(j, 1) = Cells(i + 1, 1)
            Sheets("newSheet").Cells(j, 2) = Cells(i + 1, 2)
            Sheets("newSheet").Cells(j, 3) = Cells(i + 1, 3)
            Sheets("newSheet").Cells(j, 150) = Cells(i + 1, 4)
            Sheets("newSheet").Cells(j, 255) = Cells(i + 1, 5)
            k = 1
        End If
    Next i
    For i = 255 To 1 Step -1
        If Sheets("newSheet").Cells(1, i) = "" Then
            Sheets("newSheet").Columns(i).Delete
        End If
    Next i
End Sub

<强>来源：

<强>输出：