Loop через массив с вложенными Ifs Faster

Question

У меня есть массив данных на одном листе. Мне нужно пройти через массив, оценить каждую строку на основе определенных критериев, а затем взять критерии согласованных строк и скопировать их на другой рабочий лист. Для этого я написал следующий код.

Однако цикл занимает слишком много времени. Это займет около 5 минут. Мне нужно, чтобы он работал менее чем за 30 секунд. Я прочитал следующий q на SO: What is the most efficient/quickest way to loop through rows in VBA (excel)?, и это привело меня к созданию массива. Я также пытался сохранить код простым. Я выключаю экран и активирует события.

Что можно сделать, чтобы ускорить этот процесс? Спасибо за помощь.

Sub tester() 

Dim vData() As Variant 
Dim R As Long 
Dim C As Long 
Dim LastRow1 As Long 
Dim rng1 As Range, rng2 As Range 

Set sh3 = Sheets("ABC") 
Set sh5 = Sheets("XYZ") 

Application.ScreenUpdating = False 
Application.EnableEvents = False 

LastRow1 = sh3.Cells(Rows.Count, "A").End(xlUp).Row 
vData = Range("A1:N" & LastRow1).Value 

sh5.Range("B3:AV10000").ClearContents 

For R = 1 To UBound(vData, 1) 
    For C = 1 To UBound(vData, 2) 
     If sh3.Cells(R, "G").Value <= Date Then 'if date is prior to today then 
      If sh3.Cells(R, "J").Value = "C" Then 
       If sh3.Cells(R, "D").Value > 0 Then 
        If sh3.Cells(R, "I").Value >= sh3.Cells(R, "H").Value Then 
         Set rng1 = sh3.Range("A" & R & ":N" & R) 
         Set rng2 = sh5.Range("B" & R & ":O" & R) 
         rng1.Copy rng2 
        Else 
         Set rng3 = sh3.Range("A" & R & ":N" & R) 
         Set rng4 = sh5.Range("B" & R & ":O" & R) 
         rng3.Copy rng4 
        End If 
       ElseIf sh3.Cells(R, "D").Value < 0 Then 
        If sh3.Cells(R, "I").Value >= sh3.Cells(R, "H").Value Then 
         Set rng5 = sh3.Range("A" & R & ":N" & R) 
         Set rng6 = sh5.Range("B" & R & ":O" & R) 
         rng5.Copy rng6 
        Else 
         Set rng7 = sh3.Range("A" & R & ":N" & R) 
         Set rng8 = sh5.Range("B" & R & ":O" & R) 
         rng7.Copy rng8 
        End If 
       End If 
      End If 
     End If 
    Next C 
Next R 

Application.ScreenUpdating = True 
Application.EnableEvents = True 

End Sub 

Answer 1

В соответствии с моим комментарием, попробуйте использовать Application.Calculation = xlCalculationManual и Application.DisplayAlerts = False, чтобы ускорить процесс.

Просто не забудьте положить Application.Calculation = xlCalculationAutomatic и Application.DisplayAlerts = True в конце :)

Answer 2

Кроме того - вы теряете много спасительной функциональность массива путем частых вызовов обратно к апи времени. Пример:

if sh3.Cells(R, "G").Value 

должно быть то же самое, как

if vData(R,7) 

Вы, вероятно, не нужна петля

For C = 1 to ubound(vData,2) 
Next C 

Вы не ссылаться на него в любом месте и собирается экспоненциально увеличить количество инструкций.

Попробуйте выполнить свой код, используя f8, с открытым окном местных жителей и посмотрите, что происходит с переменными, которые вы объявили для получения дополнительной информации.

Вы должны манипулировать значения внутри массива по сравнению с листа, как раз в конце процедуры вы можете заменить значения ActiveSheet в одной команде против делать это в цикле

Просто будьте осторожны, что ваши форматы не будет переноситься в ваш массив «vData», это только значение .value используемого диапазона, поэтому форматирование будет уменьшаться, а вариант данных типа vData будет захватывать самый близкий кажущийся тип данных. Это означает, что когда что-то похоже на число, если оно имеет ведущие нули, даже если это текст после того, как вы отбросили его на листе, вы потеряете те ведущие нули, которые должны форматировать ячейки до установки значений внутри api иначе первенствую просто делает то, что он делает лучше всего, я хотел бы использовать что-то вроде

sh5.cells.NumberFormat = "@"