0

なぜこのコードはとても遅いのですか? エクセルの速度を上げる方法。コードを遅くしているもの。どうもありがとう

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
4

2 に答える 2

1

Option Explicit変数にタイプミスがないことを確認するために使用します

追加のスピードアップ: すべての値をループする必要をなくすために、範囲を変更するときに数式をコピーしたかのように 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"
于 2013-07-12T14:00:04.340 に答える