Excelmacros可以更有效地合并重复的单元格并合计相应的数据

我有下面的代码,合并重复的单元格,然后总结其他列中的相应的单元格。 所以例如,如果我有:

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 

这将列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 

在我结束的时候,大概有五万行

只要一个快速的胜利 – 你可以做到这一点:

 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? 他们是如何申报的? 如果他们是变体,那么让他们变长。 如果它仍然很慢,那么记下哪些行应该被删除并且一步删除它们。

无需循环:

 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