Выполнение скрипта VBA быстрее

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 минут. Мои записи составляют более 100 тыс. Строк. Он бежал в течение дня, без конца. Есть ли способ оптимизировать это, поэтому мне не нужно ждать, пока я не седу?

С наилучшими пожеланиями,

Робами

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.