使VBA脚本运行得更快

我第一次在Excel VBA中工作，在我的数据集中查找包含与群集中另一个条目相同的地址的行。 这些条目必须合并，然后行被删除。 我已经提出了以下内容，这是有效的（就我从testing中所做的小样本中可以看出）：

Sub Merge_Orders() Application.ScreenUpdating = False Application.DisplayStatusBar = False Dim lastrow As Long lastrow = Cells(Rows.Count, "A").End(xlUp).Row Dim y As Long Dim x As Long Dim j As Long Dim k As Long For i = 2 To lastrow //for each row, starting below header row j = 1 y = (Cells(i, 9)) //this is the clusternumber Do While y = (Cells(i + j, 9)) //while the next row is in the same cluster x = (Cells(i, 12)) //this is the adresscode k = 1 Do While x = (Cells(i + k, 12)) //while the current adresscode is the same as the next, iterating until another adresscode is hit Cells(i, 16) = Val(Cells(i, 16)) + Val(Cells(i + k, 16)) //update cell value Cells(i, 18) = Cells(i, 18) + Cells(i + k, 18) //update cell value Cells(i, 19) = Cells(i, 19) + Cells(i + k, 19) //update cell value If Cells(i, 20) > Cells(i + k, 20) Then Cells(i, 20) = Cells(i + k, 20) //update cell value End If If Cells(i, 21) > Cells(i + k, 21) Then Cells(i, 21) = Cells(i + k, 21) //update cell value End If Cells(i, 22) = Cells(i, 22) + Cells(i + k, 22) //update cell value Cells(i, 23) = Cells(i, 23) + Cells(i + k, 23) //update cell value Rows(i + 1).EntireRow.Delete //Delete the row from which data was pulled k = k + 1 Loop j = j + 1 Loop Next i Application.ScreenUpdating = True Application.DisplayStatusBar = True End Sub 

我面临的问题是时间。 在一个〜50行的小样本上testing了5分钟。 我的项目总共超过10万行。 它已经跑了一天，没有尽头。 有没有一种方法来优化这个，所以我不必等到我灰了？

亲切的问候，

抢

Answer 1

我在评论中提到了两件事情：

1）删除k （以及整个k=k+1行）; 用jreplace。 还要将Rows(i + 1).EntireRow.Deletereplace为Rows(i + j).EntireRow.Delete 。

2）由于你正在删除行， lastrow当你到达那里时， lastrow实际上是空白的。 而不是i=2 to lastrow ，让它do while Cells(i,12)<>""什么的。 这导致它循环了一堆空的行。

此外，您可以使用数据透视表更轻松地完成这些types的汇总，或者如注释中所述，使用SQL GROUP BY 。