Makro läuft nicht durch

Sub Zeilenloeschen() Dim iZeile As Long For iZeile = 1 To ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row If Cells(iZeile, 7) = "0" And Cells(iZeile, 8) = "0" And Cells(iZeile, 9) = "0" And Cells( _ _ _ _ _ iZeile, 10) = "0" And Cells(iZeile, 11) = "0" And Cells(iZeile, 12) = "0" And Cells(iZeile, 13) _ _ _ _ = "0" And Cells(iZeile, 14) = "0" And Cells(iZeile, 15) = "0" And Cells(iZeile, 16) = "0" And _ _ _ Cells(iZeile, 17) = "0" And Cells(iZeile, 18) = "0" Then Rows(iZeile).Delete End If Next iZeile End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
das liegt an folgendem Effekt:
wenn du die Zeile 3 löscht, dann wird aus der alten Zeile 4 die neue Zeile 3, ebenso rutschen alle folgenden Zeilen um 1 nach oben.
dein Zeilenzähler springt von 3 auf 4 und die nächste geprüfte Zeile ist die neue Zeile 4 bzw die alte Zeile 5. Die alte Zeile 4 wird somit bei der Prüfung übersprungen.
die Lösungsmöglichkeiten sind folgende:
a) beim Löschen den Zeilenzähler um 1 reduzieren, damit die alte Zeile 3 nochmal geprüft wird

For iZeile = 1 To ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row
If ... Then
Rows(iZeile).Delete
iZeile = iZeile - 1
End If
Next iZeile

b) die Schleife rückwärts von der letzten zur ersten Zeile laufen lassen, dann passiert das Nachrücken in dem Zellbereich, der schon bearbeitet wurde und hat keinen Einfluss mehr:

For iZeile = ActiveSheet.Cells(Rows.Count, 7).End(xlUp).Row To 1 Step - 1
If ... Then
Rows(iZeile).Delete
End If
Next iZeile

Variante b) wäre hier vorzuziehen, da sie weniger Schleifenumläufe benötigt und keine Leerzeilen am Ende überprüft werden.
noch besser (weil schneller) wäre folgende Variante:
1. schreibe in eine Hilfsspalte am Tabellenende eine Formel, welche alle Zeilen die gelöscht werden sollen mit 0 kennzeichnet und alle die stehenbleiben müssen mit der Zeilennummer
2. schreibe in die Überschriftenzeile der Hilfsspalte ebenfalls die 0
3. wende auf die ganze Tabelle die Funktion DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN mit der Hilfsspalte als Kriterium und der Option "keine Überschrift" an.
4. lösche die Hilfsspalte wieder.
sieht als Code für deinen Fall dann so aus:

With ActiveSheet.usedrange
With .Columns(.columns.count + 1)
.FormulaR1C1 = "=IF(CountIf(RC7:RC18,""0"")=12,0,Row())"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .column, xlno
.ClearContents
End With
End with

Vorteil dieser Methode ist, dass sie auch bei grössten Datenmengen sehr schnell ist und dass die Löschbedingung über die Formel sehr variabel sein kann.
Gruß Daniel

Public Sub Zeilen_löschen() Dim i As Long For i = Sheets("Tabelle1").Cells(Rows.Count, 7).End(xlUp).Row To 1 Step -1 'Baltt anpassen With Sheets("Tabelle1") 'Blatt anpassen If Application.WorksheetFunction.CountIf(.Range(.Cells(i, 7), .Cells(i, 18)), 0) = 12 Then Rows(i).Delete End If End With Next i End Sub

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread