Schleife durch Array mit verschachtelten Ifs schneller

Question

Ich habe ein Array von Daten auf einem Arbeitsblatt. Ich muss das Array durchlaufen, jede Zeile basierend auf bestimmten Kriterien auswerten und dann die mit den Kriterien übereinstimmenden Zeilen übernehmen und sie in ein anderes Arbeitsblatt kopieren. Ich habe den folgenden Code geschrieben, um diesen Prozess durchzuführen.

Die Schleife dauert jedoch zu lange. Es dauert ungefähr 5 Minuten zu laufen. Ich brauche es in weniger als 30 Sekunden zu laufen. Ich lese die folgende q auf SO: What is the most efficient/quickest way to loop through rows in VBA (excel)? und das führte mich zum Erstellen des Arrays. Ich habe auch versucht, den Code einfach zu halten. Ich deaktiviere Bildschirmaktualisierung und aktiviere Ereignisse.

Was kann ich tun, um diesen Prozess zu beschleunigen? Danke für Ihre Hilfe.

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

Per mein Kommentar, versuchen Application.Calculation = xlCalculationManual und Application.DisplayAlerts = False mit Dinge zu beschleunigen.

Nur sicher sein Application.Calculation = xlCalculationAutomatic und Application.DisplayAlerts = True am Ende zu setzen :)

Answer 2

Auch - Sie eine Menge Zeit verlieren Array Funktionalität Einsparung durch häufige Anrufe zurück in die api machen. Beispiel:

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

sollte dasselbe sein wie

if vData(R,7) 

wahrscheinlich Sie die Schleife nicht brauchen

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

Sie sind nicht es überall Referenzierung und es wird exponentiell erhöhen die Anzahl der Anweisungen.

Versuchen Sie, Ihren Code mit f8 durchzugehen, während das lokale Fenster geöffnet ist, und beobachten Sie, was mit den Variablen passiert, die Sie für weitere Details deklariert haben.

Sie sollen die Werte innerhalb des Feldes im Vergleich zu auf dem Arbeitsblatt manipulieren, nur am Ende des Verfahrens Sie innerhalb der Schleife der Active Werte in einer Anweisung im Vergleich zu tun, dass

Nur vorsichtig sein, dass Ihre Formate ersetzen wird nicht in Ihr Array "vData" übernommen, es setzt nur den Wert des verwendeten Bereichs, daher wird die Formatierung fallen und der Variant-Datentyp vData wird den nächsten scheinbaren Datentyp aufnehmen. Das heißt, wenn etwas wie eine Zahl aussieht, wenn es führende Nullen hat, auch wenn es Text ist, nachdem Sie es in das Arbeitsblatt eingefügt haben, verlieren Sie die führenden Nullen, um die Zellen zu formatieren, bevor Sie andernfalls die Werte im api setzen excel nur das tut, was sie am besten kann, Ich mag, wie etwas verwenden

sh5.cells.NumberFormat = "@"