Question

我第一次使用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。它已经运行了一天多，看不到尽头。有没有办法优化这个，所以我不必等到灰色？

亲切的问候，

罗布

Answer 1

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

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)<>""或其他内容。这导致它循环遍历一堆空的行。

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

使VBA脚本运行得更快

1 个答案: