Automatische Zeilenlöschung mit 2 separaten Bedingungen

[Phiant]

Hallo liebe Forengemeinde,

ich habe folgenden Sachverhalt:

Ich möchte eine Liste per 1x Knopfdruck automatisch bereinigen lassen. Dazu sollen jeweils die Zeilen gelöscht werden, in denen entweder in Spalte K "JA" oder in Spalte J "Automat" steht.

Folgender Code läuft nicht mit einem Klick durch sondern stockt:

Code:

Sub BAT_und_Automaten_Löschen()
Dim i As Long
For i = 2 To 400
    If Cells(i, 11).Value = "JA" Then
        Rows(i).Delete Shift:=xlUp
    ElseIf Cells(i, 9).Value = "Automat" Then
        Rows(i).Delete Shift:=xlUp

    End If
Next i
End Sub

Von 14 "JA" und 17 "Automat" Einträgen bleiben nach dem ersten Durchlauf 5 "JA" und 6 "Automat", nach dem 2. Durchlauf 1 "JA" und 3 "Automat, nach dem 3. Durchlauf bleibt noch 1 "Automat" und erst nach dem 4. ist die Liste bereinigt.
Sehr ihr da einen Fehler im Code oder eine bessere Möglichkeit für das gewünschte Ergebnis (Office 365)?

Ich danke vorab!

Grüße,
Phiant

[Werner.M]

Hallo,

was jetzt? Spalte J ? Das wäre dann aber Cells(i, 10). In deinem Code sprichst du aber Cells(i, 9) an, das wäre dann aber Spalte I.

Bei deinem Code muss die Schleife von hinten nach vorne laufen.

Code:

For i = 400 to 2 Step - 1

Ansonsten werden direkt aufeinanderfolgende JA bzw. Automat "übersprungen".
Warum?
Annahme: i = 2, in cells(i, 11) steht JA und die Zeile wird gelöscht, nachfolgende Zeilen rücken um eins nach vorne
Sprich: die Zeile 3 rückt nach oben und wird zu Zeile 2, da du die ja gelöscht hast
Steht da jetzt auch wieder ein JA, so wird das "übersprungen" weil i im nächsten Schleifendurchgang 3 ist. Du prüfst also Zeile 3 und lässt damit die "neue" Zeile 2 mit dem JA aus, da die ja schon durchlaufen wurde.
Also bei Schleifen zum Löschen von Zeilen/Zellen immer die Schleife von hinten nach vorne laufen lassen.

Ich würde das so machen: Zuerst in einer Schleife von oben nach unten prüfen und bei einem Treffer die Zelle in einer Range Variablen sammeln und dann erst ganz am Schluß die entprechenden Zeile in einem Rutsch löschen.

Ist wesentlich schneller als die Zeilen einzeln zu löschen und die Schleife braucht auch nicht von hinten nach vorne zu laufen.

Code:

Sub BAT_und_Automaten_Löschen()
Dim i As Long, raWeg As Range

For i = 2 To 400
    If UCase(Cells(i, "K")) = "JA" Then
        If raWeg Is Nothing Then
            Set raWeg = Cells(i, "K")
        Else
            Set raWeg = Union(raWeg, Cells(i, "K"))
        End If
    ElseIf UCase(Cells(i, "J")) = "AUTOMAT" Then
        If raWeg Is Nothing Then
            Set raWeg = Cells(i, "J")
        Else
            Set raWeg = Union(raWeg, Cells(i, "J"))
        End If
    End If
Next i

If Not raWeg Is Nothing Then
    raWeg.EntireRow.Delete
End If

Set raWeg = Nothing
End Sub

Gruß Werner

[Phiant]

Danke Werner,

da hast du mir direkt geholfen! 

Die Reihenfolge war der Haken :) Deinen 2. Code verstehe ich mit meinen Laienkenntnissen leider nicht. Wenn du magst, kannst du mir die einzelnen Schritte gerne aufschlüsseln, damit ich wieder was dazulerne 

Grüße,
Phiant

[Werner.M]

Hallo,

siehe die Komentare im Code.

Code:

Sub BAT_und_Automaten_Löschen()
Dim i As Long, raWeg As Range

For i = 2 To 400
    'Ucase wandelt den Wert in der Zelle in Großbuchstaben um
    'prüft dann auf JA (alles groß geschrieben
    'hat den Vorteil, dass es somit egal ist, wie das
    'JA in der Zelle steht, groß, klein, gemischt - egal
    If UCase(Cells(i, "K")) = "JA" Then
        'raWeg ist eine Range Variable die mit Set "gefüllt" wird
        'hier wird zuerst geprüft, ob da schon eine Zelladresse drin ist
        'wenn nein (=Nothing) dann wird die Fundzelle mit set aufgenommen
        If raWeg Is Nothing Then
            Set raWeg = Cells(i, "K")
        Else
            'wenn in raWeg schon eine Zelladresse drin ist, dann wird
            'raWeg "erweitert" (Union)
            'zu dem Wert, der schon drin ist (raWeg) wird die Addresse der
            'weiteren Fundzelle hinzugefügt
            Set raWeg = Union(raWeg, Cells(i, "K"))
        End If
    ElseIf UCase(Cells(i, "J")) = "AUTOMAT" Then
        If raWeg Is Nothing Then
            Set raWeg = Cells(i, "J")
        Else
            Set raWeg = Union(raWeg, Cells(i, "J"))
        End If
    End If
Next i

'hier wieder zunächst Prüfung, ob was in raWeg drin ist
If Not raWeg Is Nothing Then
    'wenn ja, dann wird für jede Zelle die in raWeg drin ist
    'die komplette Zeile gelöscht
    'und das für alle Einträge in einem Rutsch
    'und nicht jede Zeile einzeln.
    raWeg.EntireRow.Delete
End If

'hier wird reWeg wieder geleert
Set raWeg = Nothing
End Sub

Gruß Werner