For-Next-Schleife sehr langsam
06.03.2019 08:33:52
Benni
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
Viele Grüße
Benni