Schleifendauer
Ralf_P
ich habe in einem scipt eine Schleife, die nacheinander die jeweils letzte Zeile von csv Dateien in sheet 2 schreibt, die Werte auf sheet 1 überträgt, danach die Einträge in sheet 2 löscht und die nächste csv einliest.
Das klappt auch alles hervorragend, da es sich aber insgesamt um ca. 6.300 csv Dateien handelt, wird die Zeit für den Schleifendurchlauf ab ca. 2.500 abgearbeiteten csv Dateien immer langsamer.
Mir ist noch nicht ganz klar woran das liegen könnte, denn der Arbeitsspeicher und die Prozessorauslastung bleibt von Anfang bis Ende annähernd gleich.
Vielleicht weiss ja einer von Euch weiter.
Hier mal der Code-Schnipsel mit der For-Next-Schleife:
'Zähler (z) für Gesamtanzahl der Dateien initialisieren
For i = 0 To ListAnzahl_csv - 1
If UserForm4.ListBox1.Selected(i) = True Then
z = z + 1
End If
Next
UserForm4.Label4.Caption = z
'Zähler (zz) für verbleibende Anzahl der Dateien initialisieren
zz = z
'Label für Fortschrittanzeige einblenden
UserForm4.Label4.Visible = True
UserForm4.Label5.Visible = True
UserForm4.Label6.Visible = True
UserForm4.Label7.Visible = True
UserForm4.Label8.Visible = True
UserForm4.Label9.Visible = True
'Tabelle anlegen und Überschriften einfügen
Workbooks.Add
Sheets(1).Activate
Cells(1, 1).Value = "KBS"
Cells(1, 2).Value = "Strecke"
Cells(1, 3).Value = "Teilstrecken Nr."
Cells(1, 4).Value = "Start"
Cells(1, 5).Value = "Ziel"
Cells(1, 6).Value = "Start Name"
Cells(1, 7).Value = "Ziel Name"
Cells(1, 8).Value = "Haltemuster"
Cells(1, 9).Value = "MF-Trakt."
Cells(1, 10).Value = "Fahrzeug"
Cells(1, 11).Value = "Auslastung"
Cells(1, 12).Value = "Extension"
Cells(1, 13).Value = "Weg [m]"
Cells(1, 14).Value = "Zeit [hh:mm:ss]"
Cells(1, 15).Value = "Energie ab Fahrleitung [KWh]"
Cells(1, 16).Value = "Bremsenergie ab Fahrleitung [KWh]"
'Dateinamen erstellen und neue Tabelle speichern
overview = sPath & "dpf\" & "Verbrauchsübersicht_" & PROJEKT & ".xls"
ActiveWorkbook.SaveAs overview
'
'###################################################################################################################
'Alle vorhandenen CSV auflisten und prüfen, welche ausgewählt wurden
'###################################################################################################################
For i = 0 To ListAnzahl_csv - 1
If UserForm4.ListBox1.Selected(i) = True Then
csvDatei = sPath & "dpf\" & UserForm4.ListBox1.List(i) & ".csv"
If FileLen(csvDatei) Fehlerliste = Fehlerliste & vbCrLf & csvDatei
Fehlerzähler = Fehlerzähler + 1
'MsgBox über Fehlerhafte Dateien wird am Ende des Scripts eingeblendet
Name (csvDatei) As (csvDatei & ".err")
GoTo FEHLER
End If
csvName = UserForm4.ListBox1.List(i) & ".csv"
xlsName = sPath & "dpf\" & UserForm4.ListBox1.List(i) & ".xls"
'Zähler (zz) für verbleibende Anzahl der Dateien aktualisieren
If i > 0 Then zz = zz - 1
UserForm4.Label5.Caption = zz
proz = (100 - ((zz / z) * 100)) * 3
UserForm4.Label8.Width = proz
'UserForm4.Label10.Caption = Round(proz / 3, 1) & " %"
UserForm4.Label10.Caption = Int(proz / 3) & " %"
DoEvents
'
'###################################################################################################################
'Überschriften aus Dateinamen auslesen - unterscheiden nach
'Teilstrecke mit Nummer, Teilstrecke ohne Nummer, Hauptstrecke
'###################################################################################################################
kbs = Mid(csvName, 6, 3)
NUMMER = Mid(csvName, 10, 1)
If NUMMER Like "#" Then
NUMMER = True
Else
NUMMER = False
End If
'
If NUMMER = True Then
strecke = "TeilStr"
streckeNr = Mid(csvName, 10, 2)
Start = Mid(csvName, 13, 4)
ziel = Mid(csvName, 18, 4)
expr = ""
MFtrakt = Mid(csvName, 23, 2)
fahrzeug = Mid(csvName, 25, 3)
auslastung = Mid(csvName, 28, 3)
extension = Mid(csvName, 32, 3)
ElseIf Mid(csvName, 10, 1) = "_" And Mid(csvName, 11, 1) = "_" Then
strecke = "TeilStr"
streckeNr = ""
Start = Mid(csvName, 13, 4)
ziel = Mid(csvName, 18, 4)
expr = ""
MFtrakt = Mid(csvName, 23, 2)
fahrzeug = Mid(csvName, 25, 3)
auslastung = Mid(csvName, 28, 3)
extension = Mid(csvName, 32, 3)
ElseIf Mid(csvName, 10, 1) "_" And NUMMER = False Then
strecke = "HauptStr"
streckeNr = ""
Start = Mid(csvName, 10, 4)
ziel = Mid(csvName, 15, 4)
expr = Mid(csvName, 20, 2)
MFtrakt = Mid(csvName, 23, 2)
fahrzeug = Mid(csvName, 25, 3)
auslastung = Mid(csvName, 28, 3)
extension = Mid(csvName, 32, 3)
End If
'
'###################################################################################################################
'Daten aus markierten (gewählten) csv Protokolldateien in Tabelle 2 einlesen
'###################################################################################################################
Sheets(2).Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & csvDatei, _
Destination:=Range("A1"))
.Name = csvName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'###################################################################################################################
'Daten aus aktueller csv Protokolldatei in Tabelle 1, jeweils letzte Zeile übertragen
'###################################################################################################################
Sheets(1).Activate
n = Cells(Rows.Count, 1).End(xlUp).Row + 1
x = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
'
Cells(n, 1).Value = kbs
Cells(n, 2).Value = strecke
Cells(n, 3).NumberFormat = "00"
Cells(n, 3).Value = streckeNr
Cells(n, 4).Value = Start
Cells(n, 5).Value = ziel
Cells(n, 6).Value = Sheets(2).Cells(2, 1).Value
Cells(n, 7).Value = Sheets(2).Cells(x, 1).Value
Cells(n, 8).Value = expr
Cells(n, 9).Value = MFtrakt
Cells(n, 10).Value = fahrzeug
Cells(n, 11).Value = auslastung
Cells(n, 12).Value = extension
Cells(n, 13).Value = Sheets(2).Cells(x, 3).Value
Cells(n, 14).Value = Sheets(2).Cells(x, 5).Value / 86400
Cells(n, 14).NumberFormat = "h:mm:ss;@"
Cells(n, 15).Value = Round(Sheets(2).Cells(x, 7).Value, 2)
Cells(n, 15).NumberFormat = "0.00"
Cells(n, 16).Value = Round(Sheets(2).Cells(x, 9).Value, 2)
Cells(n, 16).NumberFormat = "0.00"
'###################################################################################################################
'Daten in Tabelle 2 löschen, um nächste csv Datei einzulesen
'###################################################################################################################
Sheets(2).Cells().Delete
End If
FEHLER:
Next
'###################################################################################################################
'Tabelle 2 löschen und Tabelle 1 formatieren
'###################################################################################################################
'
ActiveWorkbook.Sheets(2).Delete
Viele Grüße, Ralf