Excel 对相应列求和并删除重复项，而不更改表1中的数据（VBA）

我有一个表格1和2的excel。我的目标是创建一个宏，该宏将删除重复项，并在某些情况下将相应的值添加到正确的单元格中。我有从A到F的列。如果从A到C的列与另一行重复，则宏将删除另一行，并向列E和F添加相应的值。但如果A到D的列相同，则宏将只删除另一行，而不求和。（有类模块，但我没有在这里发布：））这里有更多的背景信息（代码与链接中的几乎相同，但现在我的问题是在代码中添加其他delete.duplicate命令）

现在宏删除了第3行，因为它与第1行重复（a到D列相同）。宏还删除了第4行，并向第1行添加了相应的值（A到C列相同）。当需要添加重复项并删除另一行时，此代码运行良好，但如果从A到D的列相同，则不会删除重复项。我不知道如何改变代码，它将工作

Private Sub CommandButton1_Click()

Dim x As Long, arr As Variant, lst As Class1
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:F" & x).Value

 End With

With Sheet2

    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:F" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes

End With

For x = LBound(arr) To UBound(arr)
    If Not dict.Exists(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)) Then
        Set lst = New Class1
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        lst.Col5 = arr(x, 5)
        lst.Col6 = arr(x, 6)
        dict.Add arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3), lst

    Else
        dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 = dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 + arr(x, 5)
        dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col6 = dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col6 + arr(x, 6)

   End If
Next x

With Sheet2
    x = 1
    For Each Key In dict.Keys
        .Cells(x, 1).Value = dict(Key).Col1
        .Cells(x, 2).Value = dict(Key).Col2
        .Cells(x, 3).Value = dict(Key).Col3
        .Cells(x, 4).Value = dict(Key).Col4
        .Cells(x, 5).Value = dict(Key).Col5
        .Cells(x, 6).Value = dict(Key).Col6

        x = x + 1
   Next Key
End With
End Sub

---

我不想更改表1中的数据。感谢您的帮助，我对编码和VBA非常陌生，因此需要帮助。

我想您是想链接到您最近的问题，而不是您当前的链接？另外，请注意：

.Range（“A1:F”&x）.移除的副本

位于图纸2的

下，而不是图纸1的
下。否，我的意思是另一个：）我有不同的excel工作：D，我需要从工作表2中删除重复项，因为我想在工作表1中保持数据不变，而宏将在工作表2中进行更改。。我解释得清楚还是不清楚..好吧，那么你的
复制的代码应该可以工作了。对我来说是的。不清楚到底是什么不起作用，然后它对E列和F列的值求和，应该只删除另一行，而不求和。对不起，这一点也不清楚。你的评论与你的帖子相矛盾。可能在翻译过程中丢失了，但您说：“
当需要添加重复项和删除另一行时，此代码运行良好，但如果A到D的列相同，则不会删除重复项，这没有多大意义。”
Private Sub CommandButton1_Click()

Dim x As Long, arr As Variant, lst As Class1
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")

With Sheet1
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:F" & x).Value

 End With

With Sheet2

    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    .Range("A1:F" & x).RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes

End With

For x = LBound(arr) To UBound(arr)
    If Not dict.Exists(arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)) Then
        Set lst = New Class1
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        lst.Col5 = arr(x, 5)
        lst.Col6 = arr(x, 6)
        dict.Add arr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3), lst

    Else
        dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 = dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col5 + arr(x, 5)
        dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col6 = dictarr(x, 1) & "|" & arr(x, 2) & "|" & arr(x, 3)).Col6 + arr(x, 6)

   End If
Next x

With Sheet2
    x = 1
    For Each Key In dict.Keys
        .Cells(x, 1).Value = dict(Key).Col1
        .Cells(x, 2).Value = dict(Key).Col2
        .Cells(x, 3).Value = dict(Key).Col3
        .Cells(x, 4).Value = dict(Key).Col4
        .Cells(x, 5).Value = dict(Key).Col5
        .Cells(x, 6).Value = dict(Key).Col6

        x = x + 1
   Next Key
End With
End Sub