Не могли бы рассказать мне, почему этот код VBA медленный. Может превосходить ручку 65 000 строк с полными заявлениями

Question

Почему этот код так медленно? Как улучшить скорость превосходства. Что замедляет работу кода. спасибо

Sub setVars() 
Set ariba = Worksheets("Ariba Source") 
Set kcm = Worksheets("KCM Commitment Report") 
Set xdata = Worksheets("Data") 
Set mani = Worksheets("Manually Investigate") 
Set comm = Worksheets("Commitments") 
Set commch = Worksheets("Commitment Changes") 
Set test1 = Worksheets("Test") Set test2 = Worksheets("Test2") 
End Sub 



Call setVars 
Dim AribaRows As Long 
Dim DataRows As Long 
Dim KCMRows As Long 
Dim flag As Boolean, flag2 As Boolean, flag3 As Boolean, flag4 As Boolean 
Dim l As Long 

    AribaRows = ariba.Cells(Rows.Count, 4).End(xlUp).Row DataRows = xdata.Cells(Rows.Count, 4).End(xlUp).Row KCMRows = kcm.Cells(Rows.Count, 1).End(xlUp).Row 

    With xdata For i = 2 To DataRows 
     .Range("U" & i).NumberFormat = "General" 
     .Range("O" & i).NumberFormat = "General" 
     .Range("P" & i).NumberFormat = "General" 
     .Range("O" & i).Formula = "=IF(MID(B" & i & ",1,2)=""WR"",B" & i & ",TRIM(MID(B" & i & ",1,7)))" 
     .Range("P" & i).Formula = "=O" & i & "&"".""&C" & i 
     .Range("Q" & i).Formula = "=IF((O" & i & "<>O" & i - 1 & "),1,IF(C" & i & "=C" & i - 1 & ",Q" & i - 1 & ",Q" & i - 1 & "+1))" 
     .Range("R" & i).Formula = "=IF(ISNUMBER(0 + MID(E" & i & ",23,3)),LEFT($E" & i & ",25),LEFT($E" & i & ",22))" 
     .Range("S" & i).Formula = "=IF(LEN(R" & i & ")=25,LEFT(RIGHT(E" & i & ", LEN(E" & i & ")-27),LEN(RIGHT(E" & i & ", LEN(E" & i & ")-27))-1),LEFT(RIGHT(E" & i & ", LEN(E" & i & ")-24),LEN(RIGHT(E" & i & ", LEN(E" & i & ")-24))-1))" 
     .Range("T" & i).Formula = "=LEFT(F" & i & ", LEN(F" & i & ")-11)" 
     .Range("U" & i).Formula = "=MID(RIGHT(F" & i & ",9),1,8)" 
     .Range("V" & i).Formula = "=G" & i 
     .Range("W" & i).FormulaArray = "=MAX(IF('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$K$2:$J$" & AribaRows & "=E" & i & "&B" & i & "&D" & i & ",'Ariba Source'!$O$2:$O$" & AribaRows & "))" 
     .Range("X" & i).Formula = "=IF(ISERROR(DATEVALUE(MONTH(W" & i & ")&"" - ""&DAY(W" & i & ")&"" - ""&YEAR(W" & i & "))),W" & i & ",DATEVALUE(MONTH(W" & i & ")&"" - ""&DAY(W" & i & ")&"" - ""&YEAR(W" & i & ")))" 
     .Range("Y" & i).Formula = "=IF(INDEX('Ariba Source'!$P$2:$P$" & AribaRows & ",MATCH(E" & i & "&B" & i & "&D" & i & ",INDEX('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$J$2:$J$" & AribaRows & ",),0))>0,(INDEX('Ariba Source'!$P$2:$P$" & AribaRows & ",MATCH(E" & i & "&B" & i & "&D" & i & ",INDEX('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$J$2:$J$" & AribaRows & ",),0))/100*INDEX('Ariba Source'!$U$2:$U$" & AribaRows & ",MATCH(E" & i & "&B" & i & "&D" & i & ",INDEX('Ariba Source'!$D$2:$D$" & AribaRows & "&'Ariba Source'!$L$2:$L$" & AribaRows & "&'Ariba Source'!$J$2:$J$" & AribaRows & ",),0)))/SUMIFS('Ariba Source'!$U$2:$U$" & AribaRows & ",'Ariba Source'!$J$2:$J$" & AribaRows & ",D" & i & ",'Ariba Source'!$L$2:$L$" & AribaRows & ",B" & i & "),0)" 
     .Range("AA" & i).Formula = "=IF(LEFT(B" & i & ",2)=""WR"","""",IF(LEN(R" & i & ")=25,A" & i & "&"".256200.8190000"",A" & i & "&"".251000.1100""))" 
     .Range("Z" & i).Formula = "=IF(LEFT(B" & i & ",2)=""WR"",0,IF(J" & i & "=""KZT"",N" & i & "*0.08,N" & i & "*0.12))" Next i ' Up to here code works perfect 
    ---------------------------------------##################### 


    For i = 2 To DataRows If DateValue(.Range("V" & i).Value) >= DateValue(MonthStart) And DateValue(.Range("V" & i).Value) <= DateValue(MonthEnd) Then 
      l = i - 1 
      flag2 = True 
      Do While .Range("A" & i).Value = .Range("A" & l).Value And .Range("O" & i).Value = .Range("O" & l).Value And l > 1 
      If .Range("R" & i).Value = .Range("R" & l).Value Then 
       If .Range("C" & i).Value = "03" Then 
       If .Range("C" & l).Value <> "00" And .Range("C" & l).Value <> "02" Then .Range("AB" & i).Value = "Manually Investigate" 
       Else 
       If CInt(.Range("C" & i).Value) > 3 And CInt(.Range("C" & i).Value) - CInt(.Range("C" & l).Value) > 1 Then .Range("AB" & i).Value = "Manually Investigate" 
       End If 
       flag2 = False 
       Exit Do 
      Else 
       If Not (.Range("R" & l).Value <> .Range("R" & l + 1).Value And .Range("C" & l).Value = .Range("C" & l + 1).Value And .Range("O" & l).Value = .Range("O" & l + 1).Value) Then 
       If .Range("C" & i).Value = "03" Then 
       If .Range("C" & i - 1).Value <> "00" And .Range("C" & i - 1).Value <> "02" Then .Range("AB" & i).Value = "Manually Investigate" 
        Else 
       If CInt(.Range("C" & i).Value) > 3 And CInt(.Range("C" & i).Value) - CInt(.Range("C" & i - 1).Value) > 1 Then .Range("AB" & i).Value = "Manually Investigate" 
       End If 
       flag2 = False 
       Exit Do 
       End If 
      End If 
      l = l - 1 
      Loop 
      If flag2 Then .Range("AB" & i).Formula = "=IF(AND(C" & i & "<>""00"",C" & i & "<>""02""),""Manually Investigate"","""")" 
      .Range("AE" & i).Formula = "=IF(AND(K" & i & "=K" & i - 1 & ",O" & i & "<>O" & i - 1 & ",R" & i & "=R" & i - 1 & "),""Manually Investigate"",IF(AND(K" & i & "=K" & i + 1 & ",O" & i & "<>O" & i + 1 & ",R" & i & "=R" & i + 1 & "),""Manually Investigate"",""""))" 
      If .Range("AE" & i).Value = "Manually Investigate" Then .Range("AE" & i - 1).Value = "Manually Investigate" 
      If .Range("AC" & i).Value <> "Manually Investigate" Then .Range("AC" & i).Formula = "=IF(AND(COUNTIF('KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ")>1,COUNTIFS('KCM Commitment Report'!$A$2:$A$" & KCMRows & ",A" & i & ",'KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ",'KCM Commitment Report'!$B$2:$B$" & KCMRows & ",""<>""&R" & i & ",'KCM Commitment Report'!$B$2:$B$" & KCMRows & ",""<>""&A" & i & "&"".256300.8190000"",'KCM Commitment Report'!$B$2:$B$" & KCMRows & ",""<>""&A" & i & "&"".256200.8190000"")>0),""Manually Investigate"","""")" 
      .Range("AH" & i).Formula = "=IF(AND(COUNTIF('KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ")>1,COUNTIFS('KCM Commitment Report'!$A$2:$A$" & KCMRows & ",""<>""&A" & i & ",'KCM Commitment Report'!$C$2:$C$" & KCMRows & ",O" & i & ")>0),""Manually Investigate"","""")" 
      .Range("AI" & i).Formula = "=IF(AND(J" & i & "<>""USD"",J" & i & "<>""KZT"",J" & i & "<>""EUR"",J" & i & "<>""GBP"",J" & i & "<>""RUB""),""Manually Investigate"","""")" 
     End If 
     .Range("AF" & i).Formula = "=IF(OR(I" & i & "=""Closed"",I" & i & "=""Cancelled"",I" & i & "=""Canceling""),""Manually Investigate"","""")" 
     If .Range("AB" & i).Value = "" And .Range("AC" & i).Value = "" And .Range("AD" & i).Value = "" And .Range("AF" & i).Value = "" Then .Range("AG" & i).Formula = "=IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AC$2:$AC$" & DataRows & ",),0),0)<>0,""Manually Investigate"",IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AD$2:$AD$" & DataRows & ",),0),0)<>0,""Manually Investigate"",IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AB$2:$AB$" & DataRows & ",),0),0)<>0,""Manually Investigate"",IF(IFERROR(MATCH(O" & i & "&""Manually Investigate"",INDEX($O$2:$O$" & DataRows & "&$AF$2:$AF$" & DataRows & ",),0),0)<>0,""Manually Investigate"",""""))))" 
     .Range("AJ" & i).Formula = "=IF(AB" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AC" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AD" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AE" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AF" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AG" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AH" & i & "=""Manually Investigate"",""Manually Investigate"",IF(AI" & i & "=""Manually Investigate"",""Manually Investigate"",""""))))))))" Next i .Calculate Dim k As Long 
     Dim st 
     k = 2 flag = False For i = 2 To DataRows 
     st = "" 
     If .Range("AB" & i) = "Manually Investigate" Then st = st + "1," 
     If .Range("AC" & i) = "Manually Investigate" Then st = st + "2," 
     If .Range("AD" & i) = "Manually Investigate" Then st = st + "3," 
     If .Range("AE" & i) = "Manually Investigate" Then st = st + "4," 
     If .Range("AF" & i) = "Manually Investigate" Then st = st + "5," 
     If .Range("AG" & i) = "Manually Investigate" Then st = st + "6," 
     If .Range("AH" & i) = "Manually Investigate" Then st = st + "7," 
     If .Range("AI" & i) = "Manually Investigate" Then st = st + "8," 
     If .Range("AJ" & i) = "Manually Investigate" Then 
      st = VBA.Strings.Left(st, Len(st) - 1) 
      k = k + 1 
      flag = True 
      mani.Range("A" & k) = st 
      mani.Range("C" & k).Value = .Range("A" & i).Value 
      mani.Range("D" & k).Value = .Range("M" & i).Value 
      mani.Range("E" & k).Value = .Range("O" & i).Value 
      mani.Range("F" & k).Value = .Range("P" & i).Value 
      mani.Range("G" & k).Value = .Range("R" & i).Value 
      mani.Range("I" & k).Value = .Range("S" & i).Value 
      mani.Range("J" & k).Value = .Range("V" & i).Value 
      mani.Range("K" & k).Value = .Range("J" & i).Value 
      mani.Range("L" & k).Value = .Range("K" & i).Value 
      mani.Range("M" & k).Value = .Range("N" & i).Value 
      mani.Range("P" & k).Value = .Range("T" & i).Value 
      mani.Range("Q" & k).Value = .Range("U" & i).Value 
      mani.Range("R" & k).Value = .Range("I" & i).Value 
      mani.Range("S" & k).Value = .Range("H" & i).Value 
      mani.Range("T" & k).Value = .Range("B" & i).Value 
      mani.Range("U" & k).Value = .Range("D" & i).Value 
      mani.Range("V" & k).Value = .Range("C" & i).Value 
      mani.Range("W" & k).Value = .Range("E" & i).Value 
      mani.Range("X" & k).Value = .Range("F" & i).Value 
     End If Next i 
     i = 2 Do Until i >= DataRows 
     If VBA.Strings.Left(.Range("B" & i), 2) <> "WR" Then 
      .Range("A" & i).EntireRow.Copy 
      .Range("A" & i).Offset(1).EntireRow.Insert 
      .Range("R" & i).Offset(1).Formula = "=AA" & i 
      .Range("K" & i).Offset(1).Formula = "=Z" & i 
      .Range("N" & i).Offset(1).Formula = "=Z" & i 
      .Range("S" & i).Offset(1).Value = "Freight-All Road incl Rail" 
      .Range("L" & i).Offset(1).Value = "" 
      .Range("Z" & i).Offset(1).Value = "" 
      .Range("AA" & i).Offset(1).Value = "" 
      i = i + 1 
      DataRows = DataRows + 1 
     End If  
i = i + 1 
Loop 
If flag = False Then 
Call commitments 
Else  
mani.Activate 
End If 
End With 

Answer 1

Вы пытались установить

Application.ScreenUpdating = False 
Application.Calculation = xlCalculationManual 

И после того, как

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True 

Интересно, как расчеты формула будет работать, когда они были изменены с помощью кода ... и ваш код слишком контекст к тому, что вы делаете, я не собираюсь его перепроектировать, чтобы посмотреть, что вы на самом деле делаете.

Эта небольшая помощь - все, что я могу предоставить.

Answer 2

использование Option Explicit, чтобы убедиться, что это не опечатка в переменных

дополнительное ускорение: спасти вас от необходимости перебора всех значений, мы можем использовать тот факт, что первенствовать будет корректировать формулу, как если бы вы скопировали это при изменении диапазона.

например.

.Range("U2:U" & datarows).NumberFormat = "General" 
...... 
.Range("O2:O" & datarows).Formula = "=IF(MID(B2,1,2)=""WR"",B2,TRIM(MID(B2,1,7)))" 
.Range("P2:P" & datarows).Formula = "=O2&"".""&C2"