HERBERS Excel-Forum - das Archiv
Fortschritt einer Schleife anzeigen
Uli

Hallo liebe Experten.
ich lese aus einem externen Programm jeden Monat per VBA eine txt-Datei in eine Excel-Tabelle ein. Außerdem formatiert die Programmierung diese Datei. Die Datei hat ca. 40.000 Zeilen. 8 Schleifen prüfen jeweils diese Zeilen auf bestimmte Varianten und optimieren diese Tabelle. Das ganze dauert ca. 20-30 min.
Meine Frage. Kann ich in meiner Userform einen Fortschritt einbauen, der mir anzeigt, bei wieviel % ich angekommen bin? Gibt es sowas?
lg
Uli

AW: Fortschritt einer Schleife anzeigen
Sepp

Hallo Uli,
ja das geht.
Lade eine Beispieldatei mit ein paar Hundert Zeilen und deinem UF hoch.
Gruß Sepp

AW: Fortschritt einer Schleife anzeigen
Uli

Danke Sepp,
komme leider erst später zum hochladen.
lg. Uli

AW: Fortschritt einer Schleife anzeigen
Daniel

Hi
ich vermute mal, dass dein Code noch Verbesserungspotential hat und sich die Bearbeitungszeit noch deutlich nach unten bringen lässt.
ansonsten ist der einfachste Weg den Fortschritt anzuzeigen, die Statusleiste am unteren Fensterrand.
dort zeigt Excel normalerweise an, was es gerade macht, du kannst diese Zeile aber auch für eigene Hinweise nutzen.
Beispielsweise so: 
For i = 1 to 1000
Application.Statusbar = "Schleife 1, bearbeitet: " & Format(i / 1000, "0%")
Next
For i = 1 to 1000
Application.Statusbar = "Schleife 2, bearbeitet: " & Format(i / 1000, "0%")
Next
Application.Statusbar = False ' gibt die Statusleiste wieder für Excel frei
ansonten gibt es in der Userform noch das Steuerelement "Progressbar"
falls es in deiner Werkzeugsammlung nicht vorhanden ist, kannst du es über das Kontextmenü "weitere Steuerelemente" hinzufügen ("Microsoft Progressbar Control")
in der Schleife dann den .Value-Wert der Progressbar mit einem Wert zwischen 1 und 100 befüllen, dieser wird dann angezeigt.
Aber wie gesagt, vorrangiges Ziel sollte sein, die Bearbeitungszeit soweit nach unten zu bringen, dass eine Progressbar nicht notwendig ist und daher dem Ratschlag von Sepp folgen und erst mal eine Beispieldatei mit deinem Code und aussagekräftigen Beispielwerten hochladen.
Gruß Daniel

AW: Fortschritt einer Schleife anzeigen
Uli

Guten Morgen,
ich habe die Datei nun angefügt. Ich musste Sie natürlich aus Datenschutz erheblich verändern und kürzen, aber damit kann man trotzdem arbeiten.
https://www.herber.de/bbs/user/99307.xlsm

AW: Fortschritt einer Schleife anzeigen
Sepp

Hallo Uli,
abseits eine Fortschritsanzeige, solltest du deinen Code erst einmal optimieren.
Anstatt 5 mal 20000 Zeilen abzuklappern geht das mit einem Aufwaschen. Und auch die Zeilen im Block zu löschen anstatt einzeln ist viel schneller. Und so zieht sich das durch den ganzen Code.
Beispiel:
Sub Hauptprogramm()
Dim zeile7 As Integer
Dim rngDel As Range
Dim lngR As Long

'On Error GoTo fehler
Application.ScreenUpdating = False

'Worksheets(2).Name = Worksheets(1).Cells(16, 2)
Call Tabelle_formatieren
'zeile7 = 1

With Sheets(1)
  For lngR = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
    If Left(.Cells(lngR, 1), 1) = "*" Or Left(.Cells(lngR, 1), 16) = "Abrechnungsliste" Or _
      Left(.Cells(lngR, 1), 1) = "=" Or Left(.Cells(lngR, 1), 11) = "Suchbegriff" Or _
      Left(.Cells(lngR, 1), 1) = "-" Then
      If rngDel Is Nothing Then
        Set rngDel = .Cells(lngR, 1)
      Else
        Set rngDel = Union(rngDel, .Cells(lngR, 1))
      End If
    End If
  Next
  If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End With

'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 1) = "*" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 16) = "Abrechnungsliste" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 1) = "=" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 11) = "Suchbegriff" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 1) = "-" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop

Call Seitenumbruch_loeschen
Call zeilen_auffuellen
Call Leerzeile_einfuegen
Call HHST_anpassen
Call Datum_erstellen
Call WfB
Call Krippe
Call IGruppe
Call IKrippe
Call AW
fehler:
'Worksheets(1).Activate 'Zielblatt aktivieren
'Worksheets(1).Cells(1, 1).Select
'Worksheets(1).[b22].Value = "Fehler! " & Format(Now(), "DD.MM.YY")
'Application.ScreenUpdating = True
'
'Sheets(1).Range("a:g").Columns.AutoFit    'stellt Spaltenbreite optimal ein
'[b22] = "formatiert"
'Sheets(1).Name = "formatierte Liste"
''Sheets("Menü").Select
'Range("B2").Select

End Sub


Gruß Sepp

AW: Fortschritt einer Schleife anzeigen
Uli

Danke Sepp, hab ich gemacht. Der code ist natürlich jetzt viel kürzer. Aber in meiner Original-Datei dauert die Prozedur dennoch ca. 10 Min.
Gibt es dafür eine Fortschrittsanzeige?

Sepps Vorschlag gilt auch für Subs
EtoPHG

Ulli,
Denn deine Prozeduren
Call Seitenumbruch_loeschen
Call zeilen_auffuellen
Call Leerzeile_einfuegen
Call HHST_anpassen
Call Datum_erstellen
Call WfB
gehen nochmals alle 20'000 Zeile durch: Also integriere deren Code in Sepps For-Next Schlaufe!
Es ist nicht zielführend auf eine Fortschrittsanzeige zu beharren, solange der Code nicht wenigstens ansatzweise optimiert ist.
Gruess Hansueli

AW: Fortschritt einer Schleife anzeigen
Rudi

Hallo,
der ist nicht nur kürzer sondern spart auch ein paar Schleifen und somit Laufzeit.
Du kannst noch das Entfernen der Seitenumbrüche integrieren. 
With Sheets(1)
For lngR = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Left(.Cells(lngR, 1), 1) = "*" Or Left(.Cells(lngR, 1), 16) = "Abrechnungsliste" Or _
Left(.Cells(lngR, 1), 1) = "=" Or Left(.Cells(lngR, 1), 11) = "Suchbegriff" Or _
Left(.Cells(lngR, 1), 1) = "-" Then
If rngDel Is Nothing Then
Set rngDel = .Cells(lngR, 1)
Else
Set rngDel = Union(rngDel, .Cells(lngR, 1))
End If
End If
If Len(.Cells(lngR, 3)) - Len(Replace(.Cells(lngR, 3), "-", "")) = 2 Then
If rngDel Is Nothing Then
Set rngDel = .Cells(lngR, 1).Offset(-1).Resize(, 4)
Else
Set rngDel = Union(rngDel, .Cells(lngR, 1).Offset(, -1).Resize(, 4))
End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End With

Da geht aber noch mehr. z.B. Zeilen auffüllen.
Gruß
Rudi

AW: Fortschritt einer Schleife anzeigen
Daniel

Hi
Zeilen einzeln löschen ist sehr langsam.
bei grösseren Datenmengen sollte man zum löschen von Zeilen nach Bedingung folgendes tun:
1. in einer Hilfsspalte am Tabellenende alle Zeilen die gelöscht werden sollen mit 0 markieren und die die stehen bleiben müssen mit der aktuellen Zeilennummer.
am besten mit einer Formel in diesem Stil: =Wenn(Bedingung erfüllt;0;Zeile())
Vorteil der Formellösung ist, dass man die Formel in alle Zellen gleichzeitig eintragen kann was dann auch sehr schnell geht.
2. in die überschriftenzeile der Hilfsspalte trägt man ebenfalls die 0 ein
3. zum Löschen der mit 0 markierten Zeilen dann die Aktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN ausführen, mit der Hilfsspalte als Kriteriumsspalte.
Gruß Daniel
Fortschritt einer Schleife anzeigen
Uli

Hallo liebe Experten.
ich lese aus einem externen Programm jeden Monat per VBA eine txt-Datei in eine Excel-Tabelle ein. Außerdem formatiert die Programmierung diese Datei. Die Datei hat ca. 40.000 Zeilen. 8 Schleifen prüfen jeweils diese Zeilen auf bestimmte Varianten und optimieren diese Tabelle. Das ganze dauert ca. 20-30 min.
Meine Frage. Kann ich in meiner Userform einen Fortschritt einbauen, der mir anzeigt, bei wieviel % ich angekommen bin? Gibt es sowas?
lg
Uli

AW: Fortschritt einer Schleife anzeigen
Sepp

Hallo Uli,
ja das geht.
Lade eine Beispieldatei mit ein paar Hundert Zeilen und deinem UF hoch.
Gruß Sepp

AW: Fortschritt einer Schleife anzeigen
Uli

Danke Sepp,
komme leider erst später zum hochladen.
lg. Uli

AW: Fortschritt einer Schleife anzeigen
Daniel

Hi
ich vermute mal, dass dein Code noch Verbesserungspotential hat und sich die Bearbeitungszeit noch deutlich nach unten bringen lässt.
ansonsten ist der einfachste Weg den Fortschritt anzuzeigen, die Statusleiste am unteren Fensterrand.
dort zeigt Excel normalerweise an, was es gerade macht, du kannst diese Zeile aber auch für eigene Hinweise nutzen.
Beispielsweise so: 
For i = 1 to 1000
Application.Statusbar = "Schleife 1, bearbeitet: " & Format(i / 1000, "0%")
Next
For i = 1 to 1000
Application.Statusbar = "Schleife 2, bearbeitet: " & Format(i / 1000, "0%")
Next
Application.Statusbar = False ' gibt die Statusleiste wieder für Excel frei
ansonten gibt es in der Userform noch das Steuerelement "Progressbar"
falls es in deiner Werkzeugsammlung nicht vorhanden ist, kannst du es über das Kontextmenü "weitere Steuerelemente" hinzufügen ("Microsoft Progressbar Control")
in der Schleife dann den .Value-Wert der Progressbar mit einem Wert zwischen 1 und 100 befüllen, dieser wird dann angezeigt.
Aber wie gesagt, vorrangiges Ziel sollte sein, die Bearbeitungszeit soweit nach unten zu bringen, dass eine Progressbar nicht notwendig ist und daher dem Ratschlag von Sepp folgen und erst mal eine Beispieldatei mit deinem Code und aussagekräftigen Beispielwerten hochladen.
Gruß Daniel

AW: Fortschritt einer Schleife anzeigen
Uli

Guten Morgen,
ich habe die Datei nun angefügt. Ich musste Sie natürlich aus Datenschutz erheblich verändern und kürzen, aber damit kann man trotzdem arbeiten.
https://www.herber.de/bbs/user/99307.xlsm

AW: Fortschritt einer Schleife anzeigen
Sepp

Hallo Uli,
abseits eine Fortschritsanzeige, solltest du deinen Code erst einmal optimieren.
Anstatt 5 mal 20000 Zeilen abzuklappern geht das mit einem Aufwaschen. Und auch die Zeilen im Block zu löschen anstatt einzeln ist viel schneller. Und so zieht sich das durch den ganzen Code.
Beispiel:
Sub Hauptprogramm()
Dim zeile7 As Integer
Dim rngDel As Range
Dim lngR As Long

'On Error GoTo fehler
Application.ScreenUpdating = False

'Worksheets(2).Name = Worksheets(1).Cells(16, 2)
Call Tabelle_formatieren
'zeile7 = 1

With Sheets(1)
  For lngR = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
    If Left(.Cells(lngR, 1), 1) = "*" Or Left(.Cells(lngR, 1), 16) = "Abrechnungsliste" Or _
      Left(.Cells(lngR, 1), 1) = "=" Or Left(.Cells(lngR, 1), 11) = "Suchbegriff" Or _
      Left(.Cells(lngR, 1), 1) = "-" Then
      If rngDel Is Nothing Then
        Set rngDel = .Cells(lngR, 1)
      Else
        Set rngDel = Union(rngDel, .Cells(lngR, 1))
      End If
    End If
  Next
  If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End With

'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 1) = "*" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 16) = "Abrechnungsliste" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 1) = "=" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 11) = "Suchbegriff" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop
'zeile7 = 1
'Do
'    If zeile7 > 20000 Then Exit Do
'    If Left(Sheets(1).Cells(zeile7, 1), 1) = "-" Then
'    Sheets(1).Cells(zeile7, 1).EntireRow.Delete
'    Else
'    zeile7 = zeile7 + 1
'    End If
'Loop

Call Seitenumbruch_loeschen
Call zeilen_auffuellen
Call Leerzeile_einfuegen
Call HHST_anpassen
Call Datum_erstellen
Call WfB
Call Krippe
Call IGruppe
Call IKrippe
Call AW
fehler:
'Worksheets(1).Activate 'Zielblatt aktivieren
'Worksheets(1).Cells(1, 1).Select
'Worksheets(1).[b22].Value = "Fehler! " & Format(Now(), "DD.MM.YY")
'Application.ScreenUpdating = True
'
'Sheets(1).Range("a:g").Columns.AutoFit    'stellt Spaltenbreite optimal ein
'[b22] = "formatiert"
'Sheets(1).Name = "formatierte Liste"
''Sheets("Menü").Select
'Range("B2").Select

End Sub


Gruß Sepp

AW: Fortschritt einer Schleife anzeigen
Uli

Danke Sepp, hab ich gemacht. Der code ist natürlich jetzt viel kürzer. Aber in meiner Original-Datei dauert die Prozedur dennoch ca. 10 Min.
Gibt es dafür eine Fortschrittsanzeige?

Sepps Vorschlag gilt auch für Subs
EtoPHG

Ulli,
Denn deine Prozeduren
Call Seitenumbruch_loeschen
Call zeilen_auffuellen
Call Leerzeile_einfuegen
Call HHST_anpassen
Call Datum_erstellen
Call WfB
gehen nochmals alle 20'000 Zeile durch: Also integriere deren Code in Sepps For-Next Schlaufe!
Es ist nicht zielführend auf eine Fortschrittsanzeige zu beharren, solange der Code nicht wenigstens ansatzweise optimiert ist.
Gruess Hansueli

AW: Fortschritt einer Schleife anzeigen
Rudi

Hallo,
der ist nicht nur kürzer sondern spart auch ein paar Schleifen und somit Laufzeit.
Du kannst noch das Entfernen der Seitenumbrüche integrieren. 
With Sheets(1)
For lngR = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Left(.Cells(lngR, 1), 1) = "*" Or Left(.Cells(lngR, 1), 16) = "Abrechnungsliste" Or _
Left(.Cells(lngR, 1), 1) = "=" Or Left(.Cells(lngR, 1), 11) = "Suchbegriff" Or _
Left(.Cells(lngR, 1), 1) = "-" Then
If rngDel Is Nothing Then
Set rngDel = .Cells(lngR, 1)
Else
Set rngDel = Union(rngDel, .Cells(lngR, 1))
End If
End If
If Len(.Cells(lngR, 3)) - Len(Replace(.Cells(lngR, 3), "-", "")) = 2 Then
If rngDel Is Nothing Then
Set rngDel = .Cells(lngR, 1).Offset(-1).Resize(, 4)
Else
Set rngDel = Union(rngDel, .Cells(lngR, 1).Offset(, -1).Resize(, 4))
End If
Next
If Not rngDel Is Nothing Then rngDel.EntireRow.Delete
End With

Da geht aber noch mehr. z.B. Zeilen auffüllen.
Gruß
Rudi

AW: Fortschritt einer Schleife anzeigen
Daniel

Hi
Zeilen einzeln löschen ist sehr langsam.
bei grösseren Datenmengen sollte man zum löschen von Zeilen nach Bedingung folgendes tun:
1. in einer Hilfsspalte am Tabellenende alle Zeilen die gelöscht werden sollen mit 0 markieren und die die stehen bleiben müssen mit der aktuellen Zeilennummer.
am besten mit einer Formel in diesem Stil: =Wenn(Bedingung erfüllt;0;Zeile())
Vorteil der Formellösung ist, dass man die Formel in alle Zellen gleichzeitig eintragen kann was dann auch sehr schnell geht.
2. in die überschriftenzeile der Hilfsspalte trägt man ebenfalls die 0 ein
3. zum Löschen der mit 0 markierten Zeilen dann die Aktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN ausführen, mit der Hilfsspalte als Kriteriumsspalte.
Gruß Daniel
Dialog-Beispiele
Bewerten Sie hier bitte das Excel-Portal