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

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

变成：

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

它在一个大的电子表格上，其中一些副本将有两个，但一些副本可能多达八个。 有人能帮我吗

有任何问题请告诉我

非常感谢

试试这个宏

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

来源：

输出：

---

只有一个问题：您有代码给我们看吗？Gowtham Shiva。谢谢你的回复。当我试图运行上面的代码时，我得到了一个语法错误。数据将有标题。我对VBA编码非常陌生。您能建议如何调整和解决上述错误吗？再次感谢您的支持assistance@redmond358我已经修改了公式，因为你有标题。请给出一个trySub removeDupes（）Dim i作为长列（“a:E”）。排序键1:=范围（“A1”）顺序1:=xl升序，标题：=xlYes-这是行highlighted@redmond358你现在能试试吗。。我已经更新了代码相同的语法错误，突出显示了第3行。。我是新来的编码。工作表名称重要吗？

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