请告诉我为什么这个VBA代码很慢。 可以擅长处理65000行充满if语句
为什么这个代码太慢？ 如何提高excel的速度 什么是减慢代码。 非常感谢
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 你试过设置吗？
Application.ScreenUpdating = False Application.Calculation = xlCalculationManual
之后
Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True
我想知道如何通过代码修改公式计算，以及您的代码是否与您所做的操作过于相关，我不会对其进行反向工程，以查看您实际正在执行的操作。
这一点帮助是我所能提供的。
使用Option Explicit来确保variables中没有拼写错误
额外的加速：为了节省您不必循环所有的值，我们可以使用excel调整公式的事实，就好像您在更改范围时复制公式一样。
例如
.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"