excel - (VBA) 如何删除重复行并将相应值求和到右列？

Question

我有一个“测试”Excel，其中有从 A-D 的 4 列。如果 A 和 B 值与另一行相同，宏将删除“较旧”行，并将另一行的相应值求和到 C 和 D 列中。

      A | B | C | D                         A | B | C | D 

 1    1 | 2 | 1 | 5                         2 | 3 | 2 | 5
 2    2 | 3 | 2 | 5                         2 | 6 | 2 | 5
 3    2 | 6 | 2 | 5      After Macro        1 | 2 | 4 | 9
 4    1 | 2 | 3 | 4      --------->         5 | 4 | 1 | 2
 5    5 | 4 | 1 | 2

已编辑!因此，这里第 1 行和第 4 行在 A 列和 B 列上具有相同的值，因此宏删除第 1 行并将第 1 行列 C D 值添加到第 4 行列 C D !!

我尝试过使用这段代码，但现在它只向 D 列添加值，而不是向 C 列添加值。我真的不知道该怎么做。这是我的代码:

    Private Sub CommandButton1_Click()

    Dim i As Long, lrk As Long, tmp As Variant, vals As Variant

        With Worksheets(1)
            tmp = .Range(.Cells(2, "A"), .Cells(Rows.Count, "D").End(xlUp)).Value2
            ReDim vals(LBound(tmp, 1) To UBound(tmp, 1), 1 To 1)
            For i = LBound(vals, 1) To UBound(vals, 1)
                vals(i, 1) = Application.SumIfs(.Columns(3), .Columns(1), tmp(i, 1), Columns(2), tmp(i, 2), Columns(3), tmp(i, 3), Columns(4), tmp(i, 4))

            Next i
            .Cells(2, "D").Resize(UBound(vals, 1), UBound(vals, 2)) = vals
            With .Cells(1, "A").CurrentRegion
                .RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
            End With
        End With
    End Sub

实际的 Excel 有近 2000 行..所以我也希望这个宏足够快。感谢您的帮助，我对我的英语感到抱歉。我希望你能理解:)

Answer 1

好吧，答案很大程度上基于 this我最近给出的答案。 @DisplayName 在同一个线程中还有另一个聪明的答案，您可能想利用它，但这是我对使用类模块和字典的可理解方法的看法。

---

假设以下输入数据从A1开始:

| 1 | 2 | 1 | 5 |
| 2 | 3 | 2 | 5 |
| 2 | 6 | 2 | 5 |
| 1 | 2 | 3 | 4 |
| 5 | 4 | 1 | 2 |

首先创建一个class模块并为其命名，例如:clssList，其中包含以下代码:

Public Col1 As Variant
Public Col2 As Variant
Public Col3 As Variant
Public Col4 As Variant

第二创建一个模块，并在其中放入以下代码:

Sub BuildList()

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

'Fill array variable from sheet
With Sheet1
    x = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:D" & x).Value
End With

'Load array into dictionary with use of class
For x = LBound(arr) To UBound(arr)
    If Not dict.Exists(arr(x, 1) & "|" & arr(x, 2)) Then
        Set lst = New clssList
        lst.Col1 = arr(x, 1)
        lst.Col2 = arr(x, 2)
        lst.Col3 = arr(x, 3)
        lst.Col4 = arr(x, 4)
        dict.Add arr(x, 1) & "|" & arr(x, 2), lst
    Else 'In case column 2 is the same then add the values to the lst object
        dict(arr(x, 1) & "|" & arr(x, 2)).Col3 = dict(arr(x, 1) & "|" & arr(x, 2)).Col3 + arr(x, 3)
        dict(arr(x, 1) & "|" & arr(x, 2)).Col4 = dict(arr(x, 1) & "|" & arr(x, 2)).Col4 + arr(x, 4)
    End If
Next x

'Transpose dictionary into sheet3
With Sheet1
    x = 1
    For Each Key In dict.Keys
        .Cells(x, 6).Value = dict(Key).Col1
        .Cells(x, 7).Value = dict(Key).Col2
        .Cells(x, 8).Value = dict(Key).Col3
        .Cells(x, 9).Value = dict(Key).Col4
        x = x + 1
    Next Key
End With

End Sub

这有点广泛，但我以这样的方式编写，这样很容易理解发生了什么。对于 20000 条记录来说应该相当快。

---

上面的结果是一个从范围 F1 开始的矩阵，如下所示:

---

Running a speed test on 100.000 rows returned a total elapsed time of around 3,4 seconds. 20.000 Records came down to around 1,8 seconds.

---

另一种更短(编写代码，而不是速度)的方法是不使用类模块并连接数组项(您将使用的分隔符存在于值中的风险很小)。顶部的链接中显示了一个示例。我刚刚看到 @RonRosenFeld 举了一个关于如何使用它的示例。