通过VBA查找重复值和总结的有效方法

Question

我在电子表格中有20,000行和34列。我需要总结两个重复列值，如果列相等并删除除第一个之外的剩余重复行，并且需要在删除行之前按降序对列E进行排序。  整个过程需要4分钟。有没有其他有效的方法可以做到这一点，关于绩效？

A(car)    B(model)     C(Num plate)     D(Country)      E(Price)      F(Tax)
1.BMW         E309           D345            Germany      456778        6733
2.BMW         E309           D345           India         456737        8643
3.Audi        Q5             H54            Austria        98833        3333
4.Benz        A34            F45            Belgium        33333         9933
5.Audi        Q5             H54            Italy          8833        13333

结果：

A(car)    B(model)     C(Num plate)     D(Country)      E(Price)      F(Tax)
1.BMW      E309           D345          Germany         913515        15376
2.Audi      Q5             H54          Austria         107666        16666 

代码：

Sub Vba()

Dim Master_workbook As Workbook
Dim Ws2_Lrow As Long
Dim Ws2_Lcol As Long
Dim rngFilter_Ws2 As Range

With Master_workbook.Worksheets("Portal")

Master_workbook.Worksheets("Portal").Activate

Ws2_Lrow = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
            Ws2_Lcol = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
            Set rngFilter_Ws2 = .Range(.Cells(1, 1), .Cells(Ws2_Lrow, Ws2_Lcol))


 Selection.Sort Key1:=Range("E1"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, Orientation:=xlTopToBottom


         'delete duplicate rows and sum up the values of respective column

            With .Cells(1, 1).CurrentRegion
                'step off the header and make one column wider
                    With .Resize(.Rows.Count - 1, .Columns.Count + 1).Offset(1, 0)
                         .Columns(.Columns.Count).Formula = "=sumifs(E:E, A:A, A2, B:B, B2, C:C, C2)"
                         .Columns(5) = .Columns(.Columns.Count).Value
                         .Columns(.Columns.Count).Formula = "=sumifs(F:F, A:A, A2, B:B, B2, C:C, C2)"
                         .Columns(6) = .Columns(.Columns.Count).Value
                         .Columns(.Columns.Count).Delete
                    End With

                'remove duplicates
                    .RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
             End With
End sub

有人可以帮帮我吗。

Answer 1

以下方式会产生更多（自动生成的）代码，但应该更快，因为它使用了内置的数据透视表功能：

1. 激活微距录制
2. 选择包含数据的列
3. 转到“插入 - 数据透视”并接受默认设置
4. 将列A，B和C放入“行标签”
5. 将列E和F拖放到“值”
中
6. 将“值字段设置”设置为“SUM”
7. 删除A，B，C
的小计
8. 选择生成的数据单元格
9. 将它们复制到剪贴板
10. 转到所需的目标小区
11. 从剪贴板粘贴
12. 停止宏录制

基于该代码（显然值得优化），您可以随时重播这些步骤。