我有以下代码,它合并重复的单元格,然后对其他列中的相应单元格求和。例如,如果我有:
mike 651
mike 115
john 380
bob 225
bob 200
结果输出为:
mike 766
john 380
bob 425
该代码适用于较小的数据集,但是当我尝试在较大的数据集(大约500,000行)上使用它时,代码非常慢(需要花费一个多小时来运行)。如何编辑我的代码以使其足够有效地合并重复项并快速汇总非常大的数据集的相应数据?
Sub mergeDups()
lastRow = ActiveSheet.UsedRange.Rows.Count
Set r = ActiveSheet.UsedRange.Resize(1)
With Application.WorksheetFunction
For iRow = lastRow - 1 To 2 Step -1
Do While Cells(iRow, 1) = Cells(iRow + 1, 1)
LastCol = r(r.Count).Column
SumCol = LastCol + 1
For iCol = 2 To SumCol
Cells(iRow, iCol) = .Sum(Range(Cells(iRow, iCol), Cells(iRow + 1, iCol)))
Next iCol
Rows(iRow + 1).delete
Loop
Next iRow
End With
End Sub
答案 0 :(得分:2)
只是为了获得快速胜利 - 你可以这样做:
Sub mergeDups()
call OnStart
lastRow = ActiveSheet.UsedRange.Rows.Count
Set r = ActiveSheet.UsedRange.Resize(1)
With Application.WorksheetFunction
For iRow = lastRow - 1 To 2 Step -1
Do While Cells(iRow, 1) = Cells(iRow + 1, 1)
LastCol = r(r.Count).Column
SumCol = LastCol + 1
For iCol = 2 To SumCol
Cells(iRow, iCol) = .Sum(Range(Cells(iRow, iCol), Cells(iRow + 1, iCol)))
Next iCol
Rows(iRow + 1).delete
Loop
Next iRow
End With
call OnEnd
End Sub
Public Sub OnStart()
Application.AskToUpdateLinks = False
Application.ScreenUpdating = False
Application.Calculation = xlAutomatic
Application.EnableEvents = False
Application.DisplayAlerts = False
End Sub
Public Sub OnEnd()
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.StatusBar = False
Application.AskToUpdateLinks = True
End Sub
此外 - LastRow和iRow是什么?他们是如何宣布的?如果它们是变体,那么让它们变长。如果它仍然很慢,请记下应删除哪些行并一步删除它们。
答案 1 :(得分:2)
不需要循环:
Sub merge()
Dim rng As Range
Dim ws As Worksheet
Set ws = ActiveSheet
With ws
Set rng = .Range("B2", .Cells(.Rows.Count, "B").End(xlUp))
rng.Offset(, 50).FormulaR1C1 = "=SUMIF(C1,RC[-51],C2)"
rng.Value = rng.Offset(, 50).Value
rng.Offset(, 50).ClearContents
rng.Offset(, -1).Resize(, 2).RemoveDuplicates 1, xlGuess
End With
End Sub
答案 2 :(得分:2)
这将对A列和B列进行求和,并将结果放在D1和向下。
Sub mergeDups()
lastRow = ActiveSheet.UsedRange.Rows.Count
Range("D1").Consolidate Sources:=Array("R1C1:R" & lastRow & "C2"), LeftColumn:=True, Function:=xlSum
End Sub
在我的最后用50,000行播放大约一秒