Fortschritt einer Schleife anzeigen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

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

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

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

Beliebteste Forumthreads (12 Monate)

Fortschritt einer Schleife anzeigen

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Fortschritt einer Schleife anzeigen

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

304 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread