Office: For Schleife, schlechte Performance

bydo · 9. Mai 2017

Hallo zusammen,

ich habe eine Tabelle mit 22.000 Ids, welche ich in einer 55.000 Zeilen großen Bestandstabelle Suche und bei Treffer einen Wert in einer Nachbarspalte überprüfe. Je nach Zusammenstellung wird etwas in eine dritte Tabelle ausgespeichert.

Mein Problem: Dieser Vorgang dauer 20 Minuten+ (ich habe den Prozess an dieser Stelle beendet). Wieso braucht der Rechner so lange und wie kann ich die Arbeit zügiger erledigen lassen?

Beispieltabelle mit Code liegt anbei, vorab vielen Dank und viele Grüße

Bydo

Ebenfalls gefragt auf
http://www.clever-excel-forum.de/Thr...rmanceprobleme
http://www.herber.de/forum/messages/1557784.html

:)

Storax · 11. Mai 2017

Das liegt daran, weil Du ständig auf die Arbeitsblätter zugreifst.
Vielleicht reicht es ja schon, die Neuberechnung, Bildschirmaktualisierung, ...abzuschalten.
Code:

Private Sub TurnOnFunctionality()
Application.Calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

Private Sub TurnOffFunctionality()
Application.Calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.EnableEvents = False
Application.ScreenUpdating = False
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

bydo · 11. Mai 2017

Nein, die Abschaltung der Funktionen hat leider keine Verbesserung gebracht.

Mc Santa · 11. Mai 2017

Hallo,

jeder Zugriff auf eine Zelle beim Lesen oder Schreiben dauert in Excel vergleichsweise lang.

Besser wäre es stattdessen, wenn du am Anfang die Tabellen "Inventar" und "Prüfliste" in einem Array speicherst. Und außerdem auch die Ausgaben zunächst in einem Array sammelst, und erst am Ende in die Tabelle "Ausgabe" schreibst.

Dadurch greifst du nur noch an 3 Stellen auf die Zellen zu und nicht mehr mehrere Millionen mal.

VG
Santa

bydo · 11. Mai 2017

Hallo McSanta, ich bin bislang noch nicht mit Arrays in berührung gekommen, könntest du anführen wie ich die Prüfliste in ein Array schreibe und in diesem suche?

EarlFred · 11. Mai 2017

Wegen CP gelöscht.

Fennek11 · 11. Mai 2017

\@alle:

die Frage wurde außerdem bei Clever-Exel und Herber gestellt. Dort gibt es auch schon Antworten incl. VBA-Code.

mfg

Mc Santa · 12. Januar 2021

von Fennek11

@alle:

die Frage wurde außerdem bei Clever-Exel und Herber gestellt. Dort gibt es auch schon Antworten incl. VBA-Code.

mfg
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Finde ich einfach nur unverschämt, weil es jetzt eine Weile gedauert hat den Code umzuprogrammieren und aber die Lösung vermutlich nicht mehr gebraucht wird.

Weil ich aber eh schon fertig bin:
Code:

Sub mcs()
Dim i As Long
Dim j As Long
Dim outRow As Long

Application.ScreenUpdating = False

Dim arInv
Dim arPruf
Dim arOut

' Daten einlesen
With Sheets("Prüfliste")
arPruf = .Range(.Cells(.Rows.CountLarge, 1).End(xlUp), .Cells(2, 7))
End With

With Sheets("Inventar")
arInv = .Range(.Cells(.Rows.CountLarge, 1).End(xlUp), .Cells(2, 6))
End With

ReDim arOut(1 To UBound(arPruf, 1), 1 To 7)

outRow = 1

For i = UBound(arPruf, 1) To LBound(arPruf, 1) Step -1

arOut(outRow, 1) = arPruf(i, 1)
arOut(outRow, 2) = Format(Now, "DD.MM.YYYY HH:MM")
arOut(outRow, 3) = "bydo@vba.ms"
arOut(outRow, 4) = "bydo"
arOut(outRow, 5) = "nicht gefunden"
arOut(outRow, 6) = "nicht gefunden"
arOut(outRow, 7) = "nicht gefunden"

For j = LBound(arInv, 1) To UBound(arInv, 1)
If arInv(j, 3) = arPruf(i, 2) Then
If arInv(j, 6) = "aktiv" Or arInv(j, 6) = "wartend" Then
arOut(outRow, 5) = ""
arOut(outRow, 6) = ""
arOut(outRow, 7) = ""
Else
arOut(outRow, 5) = arInv(j, 2)
arOut(outRow, 6) = arInv(j, 5)
arOut(outRow, 7) = arInv(j, 6)
End If
Exit For
End If
If arInv(j, 4) = arPruf(i, 2) Then
If arInv(j, 6) = "aktiv" Or arInv(j, 6) = "wartend" Then
arOut(outRow, 5) = ""
arOut(outRow, 6) = ""
arOut(outRow, 7) = ""
Else
arOut(outRow, 5) = arInv(j, 2)
arOut(outRow, 6) = arInv(j, 5)
arOut(outRow, 7) = arInv(j, 6)
End If
Exit For
End If
Next j

outRow = outRow + 1
Next i

Sheets("Ausgabe").Cells(2, 1).Resize(UBound(arOut, 1), UBound(arOut, 2)) = arOut

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Mit einem Dictionary würde es noch einmal (50.000x) schneller gehen, aber das spare ich mir nun.

VG
Santa

bydo · 11. Mai 2017

Hallo McSanta, ich wusste nicht, dass dies so gehandhabt wird und habe dies nach dem ersten Hinweis auch direkt umgesetzt, siehe eröffnungspost. Bitte unterstellt mir keine bösen Absichten.

Außerdem habe ich in keinen der beiden anderen Foren eine Hilfestellung zu Arrays erhalten, ja es wurde versucht die bestehende Programmierung zu verbessern aber bislang ohne Erfolg.

Desshalb an dieser Stelle zunächst ein unbeschreiblich großes DANKE an dich, denn deine Code funktioniert sehr gut und wird mir sehr helfen einen Einstieg in die Arrays zu erhalten.

Ich habe den Testbereich auf 22.000 Zeilen Inventar und 22.000 Prüfzeilen ausgeweitet und hier braucht der code gute 5 Minuten.

Mc Santa · 11. Mai 2017

Hallo,

danke, dass du unsere Auffassung berücksichtigst und die Kritik aufnimmst.

Kurz zum Hintergrund: Rückmeldungen auf eine gegebene Antwort sind sehr wichtig, denn sie zeigen allen zukünftigen Lesern was funktioniert und was nicht. Und außerdem sind sie für uns im Prinzip der einzige Lohn *Smilie
Die Erfahrung zeigt leider einfach, dass diese Rückmeldungen fast immer ausbleiben, wenn jemand anfängt gleichzeitig an mehreren Stellen zu fragen. Insbesondere sieht man häufig den Fall, dass in Forum A eine Lösung präsentiert wird, diese aber nicht an alle anderen Foren B, C und D weitergegeben wird. Dabei wird dann vergessen, dass jemand vielleicht in Zukunft Forum B findet und aber keine Lösung zu seinem Problem, obwohl es eine geben könnte.
Du bist nun ein gutes Beispiel dafür, dass es auch anders gehen kann, allerdings bist du damit in der Minderheit. Daher ist das gleichzeitige Fragen an verschiedenen Stellen fast nirgendwo gern gesehen.

Nach dem langen Text jetzt noch meine neue Lösung:
Code:

Option Explicit

Sub mcs()

Dim i As Long, j As Long, outRow As Long
Dim arInv, arPruf, arOut, dicInv, tmpAr

On Error GoTo Finally

If Not Sheets("Ausgabe").Cells(2, 1) = "" Then
MsgBox "In der Tabelle 'Ausgabe' sind bereits Daten vorhanden." + Chr(10) + _
"Bitte erst die alten Daten löschen", vbCritical
Exit Sub
End If

Application.ScreenUpdating = False

' Daten einlesen
With Sheets("Prüfliste")
arPruf = .Range(.Cells(.Rows.CountLarge, 1).End(xlUp), .Cells(2, 7))
End With
With Sheets("Inventar")
arInv = .Range(.Cells(.Rows.CountLarge, 1).End(xlUp), .Cells(2, 6))
End With

' Dictionary aufbauen
Set dicInv = CreateObject("Scripting.Dictionary")
For i = LBound(arInv, 1) To UBound(arInv, 1)
dicInv.Item(arInv(i, 3)) = Array(arInv(i, 6), arInv(i, 2), arInv(i, 5), arInv(i, 6))
dicInv.Item(arInv(i, 4)) = Array(arInv(i, 6), arInv(i, 2), arInv(i, 5), arInv(i, 6))
Next i

' Ausgabe Array vorbereiten
ReDim arOut(1 To UBound(arPruf, 1), 1 To 7)

' Durchlaufe alle Positionen in der Prüfliste
outRow = 1
For i = UBound(arPruf, 1) To LBound(arPruf, 1) Step -1

' Schreibe Metainformationen inm Ausgabe-Array
arOut(outRow, 1) = arPruf(i, 1)
arOut(outRow, 2) = Format(Now, "DD.MM.YYYY HH:MM")
arOut(outRow, 3) = "bydo@vba.ms"
arOut(outRow, 4) = "bydo"
arOut(outRow, 5) = "nicht gefunden"
arOut(outRow, 6) = "nicht gefunden"
arOut(outRow, 7) = "nicht gefunden"

' Suche Eintrag aus Prüfliste in Inventur
If dicInv.Exists(arPruf(i, 2)) Then

' Falls gefunden, lese Daten und schreibe sie in Ausgabe-Array
tmpAr = dicInv.Item(arPruf(i, 2))
If tmpAr(0) = "aktiv" Or tmpAr(0) = "wartend" Then
arOut(outRow, 5) = ""
arOut(outRow, 6) = ""
arOut(outRow, 7) = ""
Else
arOut(outRow, 5) = tmpAr(1)
arOut(outRow, 6) = tmpAr(2)
arOut(outRow, 7) = tmpAr(3)
End If
End If

outRow = outRow + 1
Next i

' Ausgabe der Daten
Sheets("Ausgabe").Cells(2, 1).Resize(UBound(arOut, 1), UBound(arOut, 2)) = arOut

Finally:
Application.ScreenUpdating = True

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Bitte teste sie an deiner Tabelle und gib kurz Rückmeldung, ob alles funktioniert und wie lange der Code zum Durchlaufen braucht.

VG
Santa

Office: For Schleife, schlechte Performance

For Schleife, schlechte Performance

For Schleife, schlechte Performance

For Schleife, schlechte Performance

For Schleife, schlechte Performance

For Schleife, schlechte Performance - Similar Threads - For Schleife schlechte

For Next Schleife

Access For next Schleife

For Each Schleife Anstatt ActiveSheet festen Tabellenblattnamen benutzen

For-Next-Schleife für Textfeldübertragung

For Schleife nicht initialisiert

Glücksrad mit VBA und For-Schleifen

"find and replace" mit "for-Schleife" kombinieren