0
我在電子表格中有20,000行和34列。我需要總結兩個重複的列值,如果列相同並刪除除第一個以外的其餘行重複,並且需要在刪除行之前按降序對列E進行排序。 完成整個過程需要4分鐘的時間。有沒有其他有效的方法來做到這一點,關心績效?通過VBA查找重複值並進行總結的有效方法
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
有人可以幫助我。
您的結果表格不會正確彙總您的原始表格,因爲國家/地區列仍在結果表格中。我認爲你想要做的事會混淆你的報告用戶。 :) 如果您忽略潛在的混淆,一種方法是使用列A +列B的鍵構造字典(請參閱Scripting.dictionary)。 – Danielle
@Danielle country列必須位於結果表中。它應該基於列(A,B,C)總結列(E,F)。 –