Office: (Office 2010) VBA - Zeile löschen bei mehreren IF-And Bedingungen

Ausgangstabelle (Excel 2010)



Ich möchte komplette Zeilen löschen wenn in einem bestimmten Bereich gleichzeitig das Wort "off" steht. In diesem Beispiel:

Wenn in Spalte C egal welche Zeile und in Spalte D egal welche Zeile und in Spalte E egal welche Zeile das Wort "off" steht, soll die gesamte Zeile gelöscht werden.

Meine VBA-Versuche scheitern kläglich. Letzter Code, bei dem nichts passiert:

Code:

Sub Zeile_Loeschen() 'fast richtig

    Dim Bereich As Range, zelle As Range
    Application.ScreenUpdating = False
    Set Bereich = Range("A1:F10")
    For Each zelle In Bereich
        If Range("c2") = "off" And Range("d2") = "off" And Range("e2")  = "off" Then
            zelle.EntireRow.Delete Shift:=xlUp
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Ich vermute, es liegt an der komplett falschen Definition des Suchbereiches. Komme aber einfach nicht weiter. Hilfe!

 

Hallo,

mit "fast richtig" liegst Du mal völlig daneben!

Code:

Sub löschen()
Dim loA as long
For loA=10 to 1 step -1
if cells(loa,3)="off" and cells(loA,4)="off" then rows(loa).delete shift:=xlup
next
End sub

ungetestet!

 

Hi,

Damit liegst du vollkommen richtig, da du ja im Bereich A1:F10 alle Zellen durchläufst, aber eigentlich nur jeder Zeile einmalig durchlaufen willst. Außerdem prüfst du bei jedem Schleifendurchlauf die Zellen C2, D2 und E2, wogegen du ja jede Zeile prüfen musst. So wird ein Schuh daraus:

Code:

    Set Bereich = Range("A1:A10")
    For Each zelle In Bereich
        If zelle.Offset(0, 2) = "off" And zelle.Offset(0, 3) = "off" And zelle.Offset(0, 4) = "off" Then
            zelle.EntireRow.Delete Shift:=xlUp
        End If
    Next

Bis später,
Karin

 

Bei mehr als 1000 Datensätzen ist deren Einzellöschung extrem langsam, vorwärts noch langsamer als rückwärts. Daher folgendes in VBA nachprogrammieren:

Neue Spalte G:
G2: {=UND(C2:E2="Off")} oder =ZÄHLENWENN(C2:E2;"Off")=3 runterkopieren
G nach FALSCH autofiltern
Autofiltrat ohne G in neues Blatt kopieren
Kompletten neuen Blattinhalt über Ausgangsblatt kopieren
Neues Blatt entsorgen

Das Makro dürfte dann bei 1000 Sätzen 1 Größenordnung, bei 3000 Sätzen 2 Größenordnungen schneller sein.

Eine ähnlich gleich schnelle Möglichkeit ist die Kopie und Rückeinfügung der Tabelle in und über VBA-Variants.

 

BoskoBiati: funktioniert. Einwandfrei. Tausend Dank.
Beverly: Da passiert leider überhaupt nichts. Es rührt sich gar nichts. Dennoch danke für den Versuch.
Lupo1: Mehr als 1.000 Datensätze wird es nicht werden, aber danke für den Hinweis.

 

Dann machst du etwas falsch. Schau dir die angehängte Mappe an - in Tabelle "Ausgang" siehst du die Startsituation (in Zeile 2 und 10 steht jeweils in Spalte C, D und E der Begriff "off") und in Tabelle "Ergebnis" siehst du die Situation nach Ausführung des Makros: es fehlen Zeile 2 und Zeile 10, also genau die welche der Code löschen soll.


Nimm dann mal den Code aus Beitrag 2 und lasse dabei in einer Zeile Spalte E leer - diese Zeile wird gelöscht, obwohl sie nicht gelöscht werden darf, da die Bedingung ja ist, dass auch in E "off" stehen muss.

Bis später,
Karin

 

Hallo Karin,

schön das Du das erwähnst! Da habe ich doch glatt diese Bedingung vergessen:

Code:

Sub löschen()
Dim loA as long
For loA=10 to 1 step -1
if cells(loa,3)="off" and cells(loA,4)="off" and cells(loA,5)="off" then rows(loa).delete shift:=xlup
next
End sub

Code:

Sub löschen()
Dim loA as long
For loA=10 to 1 step -1
if application.countif(Range(cells(loa,3),cells(loa,5)),"off")=3 then rows(loa).delete shift:=xlup
next
End sub