For-Next-Schleife sehr langsam

Forumthread: For-Next-Schleife sehr langsam

06.03.2019 08:33:52

Benni

Hallo zusammen,
dies ist mein erster Beitrag hier, daher verzeiht, falls ich "blöde" Nachfragen stelle.
Ich stehe vor folgendem Problem:
Mittels zweier Makros möchte ich
1) Zeilen, in denen im Tabellenblatt in Spalte 1 kein x vorkommt (sprich ""), löschen und
2) Werte aus einem anderen Tabellenblatt (wo ebenfalls wieder in Spalte 1 Leere herrscht) in voriges Blatt kopieren in vordefinierte Spalten.
Die Makros funktionieren tatsächlich einwandfrei, brauchen jedoch jeweils ca. 10-15 Minuten bei einer Tabellenlänge von ca. 1500 Stellen.
Ich hänge im Folgenden beide Makros an.
Vielleicht hat jemand eine Idee/ einen Alternativweg, mit dem ich effizienter vorgehen kann und schneller zum Ziel komme!
Makro 1)
Option Explicit

Public Sub Alteintraege_entfernen()
Dim ziel_ws As Worksheet
Set ziel_ws = ThisWorkbook.Worksheets("xxx")
'Variablen Deklaration
Dim ziel_row As Long, ziel_lrow As Long, ziel_ind As Long
'Letzte Zeile berechnen
ziel_lrow = ziel_ws.Cells(Rows.Count, 8).End(xlUp).row
ziel_ind = 0
For ziel_row = ziel_lrow To 8 Step -1
If ziel_ws.Cells(ziel_row, 1).Value = "" Then
ziel_ind = 1
End If
If ziel_ind = 1 Then
ziel_ws.Rows(ziel_row).Delete Shift:=xlUp
ziel_ind = 0
End If
Next ziel_row
End Sub

Makro 2)
Option Explicit

Public Sub Neueintraege_kopieren()
Dim quell_ws As Worksheet, ziel_ws As Worksheet
Set quell_ws = ThisWorkbook.Worksheets("yyy")
Set ziel_ws = ThisWorkbook.Worksheets("xxx")
Dim quell_row As Long, quell_lrow As Long, quell_ind As Long, ziel_row As Long, ziel_lrow As  _
Long
quell_lrow = quell_ws.Cells(Rows.Count, 7).End(xlUp).row
ziel_lrow = ziel_ws.Cells(Rows.Count, 8).End(xlUp).row
quell_ind = 0
ziel_row = ziel_lrow + 1
For quell_row = quell_lrow To 2 Step -1
If quell_ws.Cells(quell_row, 1).Value = "" Then
quell_ind = 1
End If
If quell_ind = 1 Then
ziel_ws.Cells(ziel_row, 8) = quell_ws.Cells(quell_row, 7)
ziel_ws.Cells(ziel_row, 11) = quell_ws.Cells(quell_row, 10)
ziel_ws.Cells(ziel_row, 12) = quell_ws.Cells(quell_row, 11)
ziel_ws.Cells(ziel_row, 13) = quell_ws.Cells(quell_row, 12)
ziel_row = ziel_row + 1
quell_ind = 0
End If
Next quell_row
End Sub

Vielen Dank im Voraus!
Viele Grüße
Benni

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: For-Next-Schleife sehr langsam

06.03.2019 08:44:06

Luschi
AW: For-Next-Schleife sehr langsam

06.03.2019 08:58:02

Benni
AW: For-Next-Schleife sehr langsam

06.03.2019 10:17:04

Daniel
erst sammeln, dann löschen

06.03.2019 11:54:05

Rudi

AW: For-Next-Schleife sehr langsam

06.03.2019 08:44:06

Luschi

Hallo Benni
schalte zu Makrobeginn folgende Excel-Einstellungen um/aus:
- Bildschirmaktualisierung
- automatische Berechnung
- interne Excel-Ereignisse
Wie das geht, verrät Dir die Vba-Routine 'getMoreSpeed' (suche mit aGoogle Browser Deiner Wahl)
Gruß von Luschi
aus klein-Paris
PS: am Schluß natürlich wieder einschalten nicht vergessen!

AW: For-Next-Schleife sehr langsam

06.03.2019 08:58:02

Benni

Hallo Luschi,
der Wahnsinn, statt 15 Minuten warten weniger als eine Minute!
Vielen Dank Dir!
Beste Grüße
Benni

AW: For-Next-Schleife sehr langsam

06.03.2019 10:17:04

Daniel

Hi
Punkt 1 ließe sich so schneller durchführen (auch ohne GetMoreSpeed)
a) wenn die Zellen in Spalte A echte Leerzellen sind:

ziel_ws.Columns(1).SpecialCells(xlcelltypeblanks).EntireRow.Delete

b) die Standardlösung zum schnellen löschen von Zeilen mit Bedingung:
- alle Zeilen die gelöscht werden sollen in einer Hilfsspalte per Formel mit 0 kennzeichnen und die die stehenblbeiben müssen mit der aktuellen Zeilennummer
- in die Zeile 1 der Hilfsspalte ebenfalls die 0 schreiben
- auf das ganze Blatt die Funktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN anwenden, mit der Hilfsspalte als Kriterium.
geht auch als Code:

with ziel_ws.Usedrange
with .columns(.columns.count + 1)
.FormulaR1C1 = "=IF(RC1="""",0,Row())"
.Cells(1, 1).value = 0
.EntireRow.Removeduplicates .column, xlno
.ClearContents
end with
end with

ansonsten kann man das ganze noch beschleunigen, wenn man überflüssige Abfragen vermeidet und Zellen, die direkt nebeneneinander liegen, auch möglicht in einem Schritt bearbeitet.
dein zweites Makro leicht optimiert so:

Public Sub Neueintraege_kopieren()
Dim quell_ws As Worksheet, ziel_ws As Worksheet
Set quell_ws = ThisWorkbook.Worksheets("yyy")
Set ziel_ws = ThisWorkbook.Worksheets("xxx")
Dim quell_row As Long, quell_lrow As Long, quell_ind As Long, ziel_row As Long, ziel_lrow As   _
_
Long
quell_lrow = quell_ws.Cells(Rows.Count, 7).End(xlUp).row
ziel_lrow = ziel_ws.Cells(Rows.Count, 8).End(xlUp).row
quell_ind = 0
ziel_row = ziel_lrow + 1
For quell_row = quell_lrow To 2 Step -1
If quell_ws.Cells(quell_row, 1).Value = "" Then
ziel_ws.Cells(ziel_row, 8) = quell_ws.Cells(quell_row, 7)
ziel_ws.Cells(ziel_row, 11).Resize(, 3) = quell_ws.Cells(quell_row, 10).Resize(, 3)
ziel_row = ziel_row + 1
End If
Next quell_row
End Sub

Gruß Daniel

erst sammeln, dann löschen

06.03.2019 11:54:05

Rudi

Hallo,

Public Sub Alteintraege_entfernen()
'Variablen Deklaration
Dim ziel_ws As Worksheet, rngDel As Range
Dim ziel_row As Long, ziel_lrow As Long
Set ziel_ws = ThisWorkbook.Worksheets("xxx")
With ziel_ws
'Letzte Zeile berechnen
ziel_lrow = .Cells(Rows.Count, 8).End(xlUp).Row
For ziel_row = ziel_lrow To 8 Step -1
If .Cells(ziel_row, 1).Value = "" Then
If rngDel Is Nothing Then
Set rngDel = .Cells(ziel_row, 1)
Else
Set rngDel = Union(rngDel, .Cells(ziel_row, 1))
End If
End If
Next ziel_row
End With
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

Forumthread: For-Next-Schleife sehr langsam

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread