使 VBA 脚本运行得更快答案

【问题标题】：Making VBA script run faster使 VBA 脚本运行得更快
【发布时间】：2017-01-20 07:48:04
【问题描述】：

我第一次使用 Excel VBA 在我的数据集中查找与集群中的另一个条目包含相同地址的行。必须合并这些条目，然后删除该行。我提出了以下可行的方法（据我对集合的小样本进行的测试可以看出）：

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 行的小样本进行测试需要 5 多分钟。我的条目总计超过 100K 行。它已经运行了一天多，看不到尽头。有没有办法对此进行优化，这样我就不必等到我变灰了？

亲切的问候，

罗伯

【问题讨论】：

你有什么东西在单元格中计算吗？如果是这样，将这些行分别放在顶部和底部可能会有所帮助：Application.Calculation=xlManual 和 Application.Calculation=xlAutomatic
我假设 // 是您为 SO 添加的 cmets，而不是在代码本身中？（因为' 是 VBA 的注释标记）。如果您使用F8 单步执行代码，循环似乎卡在了哪里？也可能在循环的每个部分添加一些中断，以帮助确定循环花费的时间比预期的多。
如果您的代码按预期工作（除了性能 - 使用小数据集进行测试以确保），那么寻求反馈和优化提示的最佳位置是 Code Review，而不是 @987654322 @.
你的问题将是由于 Do While y 和 Do While x 循环继续“永远”一旦 Cells(i, 9) 或 Cells(i, 12) 是 Empty （一旦 i 达到完全空行，这会发生，因为您正在删除行，但仍然循环到您删除任何内容之前的最后一个行号）。您可以尝试将循环更改为For i = lastrow To 2 Step -1。我还没有充分分析你在做什么来确定这是否会给你带来任何其他问题，但它应该可以解决与空单元格比较引起的问题。
或者您可以在For i = 2 To lastrow 语句之后立即添加一个声明If IsEmpty(Cells(i, "A")) Then Exit For。

标签： vba excel optimization

【解决方案1】：

正如我在 cmets 中提到的两件事：

1) 删除k（以及整个k=k+1 行）；替换为j。还将您的Rows(i + 1).EntireRow.Delete 替换为Rows(i + j).EntireRow.Delete。

2) 由于您正在删除行，所以当您到达那里时，lastrow 实际上是空白的。而不是i=2 to lastrow，改为do while Cells(i,12)<>"" 或其他东西。这会导致它遍历一堆空的行。

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

【讨论】：