Schleife läuft ewig
26.02.2016 21:43:40
EasyD
Ich habe mit viel Mühe eine Schleife gebaut, die nacheinander in zwei Tabellenblättern jeweils die Differenz aus 2 Spalten rechnet und das Ergebnis in ein drittes Tabellenblatt schreibt. Eigentlich nicht ungewöhnlich denke ich. Das Problem ist, der Code läuft waaaaaahhhhnsinnig langsam. Ich habe das jetzt schon ein paar mal angestoßen und unterschiedlich lange laufen lassen bevor ich es abgewürgt habe. Das Ergebnis waren unterschiedlich viele in dem dritten Tabellenblatt eingetragene Werte bei jedem Versuch. Daraus folgere ich, dass der Code eigentlich fehlerfrei läuft, nur halt extrem langsam.
Die Blätter die ausgelesen werden haben beide jeweils irgendwas um die 8.000 mit Daten gefüllte Zeilen. Ist recht viel, aber kann das wirklich ein Problem sein?
Der Code:
(sorry für diesen krückenhafte Darstellung, das macht der editor hier selber)
Sub Uebertrag()
Dim LoletzteA As Long
Dim LoletzteB As Long
Dim Loi As Long
Dim Lozeile As Long
If MsgBox("Haben Sie die Kontenblätter eingefügt?", vbYesNoCancel, "Daten aktualisieren") = _
vbYes Then
' Arbeitsschritt Tabelle Bank durchlesen
With Worksheets("Bank")
LoletzteA = IIf(IsEmpty(.Cells(Rows.Count, 13)), .Cells(.Rows.Count, 13).End(xlUp).Row, _
.Rows.Count)
LoletzteB = IIf(IsEmpty(.Cells(Rows.Count, 14)), .Cells(.Rows.Count, 14).End(xlUp).Row, _
.Rows.Count)
For Loi = 1 To Application.WorksheetFunction.Max(LoletzteA, LoletzteB)
' Wenn Spalte 5 Numerisch ist dann
If IsNumeric(.Cells(Loi, 5)) Then
' Errechne aus Tabelle Bank Spalten 13 (Soll) und 14 (Haben) und schreibe in _
Tabelle Zahlung Spalte4
Worksheets("Zahlung").Cells(Lozeile + 1, 4) = .Cells(Loi, 13) - .Cells(Loi, 14)
' Ermittele aus Tabelle Bank Spalte5 (E) und schreibe in Tabelle Zahlung _
Spalte3
Worksheets("Zahlung").Cells(Lozeile + 1, 3) = .Cells(Loi, 5)
'Wert für die Schule einfügen
Worksheets("Zahlung").Cells(Lozeile + 1, 2) = 16 & Left(.Cells(Loi, 5), 3)
Else
'Beschriftung in Spalte5 der Tabelle Zahlung
Worksheets("Zahlung").Cells(Lozeile + 1, 5) = "Bank"
End If
Lozeile = Lozeile + 1
Next Loi
End With
' Arbeitsschrift Tabelle Verrechnung durchlesen, identische Prozedur
With Worksheets("Verrechnung")
LoletzteA = IIf(IsEmpty(.Cells(Rows.Count, 13)), .Cells(.Rows.Count, 13).End(xlUp).Row, _
.Rows.Count)
LoletzteB = IIf(IsEmpty(.Cells(Rows.Count, 14)), .Cells(.Rows.Count, 14).End(xlUp).Row, _
.Rows.Count)
For Loi = 1 To Application.WorksheetFunction.Max(LoletzteA, LoletzteB)
If IsNumeric(.Cells(Loi, 5)) Then
Worksheets("Zahlung").Cells(Lozeile + 1, 4) = .Cells(Loi, 13) - .Cells(Loi, 14)
Worksheets("Zahlung").Cells(Lozeile + 1, 3) = .Cells(Loi, 5)
Worksheets("Zahlung").Cells(Lozeile + 1, 2) = 16 & Left(.Cells(Loi, 5), 3)
Else
Worksheets("Zahlung").Cells(Lozeile + 1, 5) = "Verrechnung"
End If
Lozeile = Lozeile + 1
Next Loi
End With
ActiveWorkbook.RefreshAll
ElseIf MsgBox("Haben Sie die Kontenblätter eingefügt?", vbYesNoCancel, "Daten aktualisieren") = _
vbNo Then
MsgBox "dann bitte nachholen!"
Else
MsgBox "Die Auswertung entspricht nicht dem aktuellen Stand!"
End If
End Sub