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

【问题标题】：Excel VBA - Merging cells based on duplicates searchExcel VBA - 基于重复搜索合并单元格
【发布时间】：2023-03-27 07:53:01
【问题描述】：

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

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

它在一个大型电子表格中，其中一些受骗者会有两个，但有些可能多达八个。谁能帮帮我？

如有任何问题，请告诉我。

非常感谢！

【问题讨论】：

只有一个问题：你有什么代码可以给我们看吗？

标签： excel vba merge duplicates

【解决方案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

来源：

输出：

【讨论】：

高瑟姆湿婆。感谢您的回复。当我尝试运行上述代码时出现语法错误。数据将有标题。我对 VBA 编码非常陌生。您能建议如何调整和解决上述错误吗？再次感谢您的帮助
@redmond358 我已经修改了公式，因为你有标题。请试一试
Sub removeDupes() Dim i As Long Columns("A:E").Sort key1:=Range("A1") order1:=xlAscending, header:=xlYes - 这是突出显示的行
@redmond358 你现在可以试试.. 我已经更新了代码
相同的语法错误，第 3 行突出显示。我是编码新手。工作表名称重要吗？