Question

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

Here is an example:
Sheet1          Sheet2
A B C D E F     A B C D E F
1 2 2 3 3 3     1 2 2 7 3 3
1 1 1 1 1 1     1 1 1 1 1 1
1 2 2 3 3 3     
1 2 2 4 3 3

现在宏已删除第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

我不想更改sheet1中的数据。谢谢您的帮助，我在编码和VBA方面还很陌生，所以需要帮助。

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

0 个答案: