Zeilen mit bestimtem Inhalt löschen

[rodlof]

Meine lieben Freunde

Ich habe ein Problem, das mich nicht loslässt. In riesigen Dateien (200'000 bis 500'000 Zeilen) muss ich Zeilen löschen, die einen bestimmten Eintrag (Beurteilung = OK) in einer Spalte haben. Ich wollte eigentlich alle Zeilen mit dem Kriterium selektieren oder filtern und dann alle miteinander löschen. Aber ich habe das nicht hingekriegt. Die Vorgehensweisen in den schlauen Büchern und in Excel-Foren funktionieren alle nicht. :22:

Damit es wenigstens funktioniert, gehe ich nun zu Fuss und lösche jede Zeile einzeln. Da mehrere Zeilen immer zusammengehören und der wesentliche Eintrag auf der 1. Zeile des Blocks gemacht wird und dann nach unten übernommen wird, muss ich die Zeilen von unten her löschen. Der Prozess so dauert aber eeeewig und mir schläft das Gesicht ein dabei.

Der Code (Ausschnitt) sieht folgendermassen aus:

Code:

Dim ErsteZeile As Integer           'Die erste Zeile mit Daten (ohne Header)
Dim LetzteZeile As Long             'Die Letzte Zeile mit Daten in einem Bereich (muss long sein)
Dim SpalteX As Integer              'Die Spalte mit der Beurteilung
Dim Text1 As String                 'Erster Text der geprüft werden soll
Dim Text2 As String                 'Zweiter Text der geprüft werden soll
Dim Text3 As String                 'Dritter Text der geprüft werden soll
Dim i As Long                       'Schlaufenzähler (muss long sein)

 Text1 = "OK 1 N/K"                 'Erster Suchtext setzen
 Text2 = "OK 2 gesamt"              'Zweiter Suchtext setzen
 Text3 = "OK 9 SPLG Def"            'Dritter Suchtext setzen

'Zeilen mit OK1, OK2, OK9 löschen (mit Einzelmethode rückwärts)
'**************************************************************
For i = LetzteZeile To ErsteZeile + 1 Step -1              'Schlaufe rückwärts setzen (erste Zeile nicht löschen)
    ActiveWorkbook.ActiveSheet.Cells(i, SpalteX).Select

   If ActiveCell.Value = Text1 Then                        'Wenn BeU = OK1, die ganze Zeile löschen
       Selection.EntireRow.Delete

   ElseIf ActiveCell.Value = Text2 Then                    'Wenn BeU = OK2, die ganze Zeile löschen
       Selection.EntireRow.Delete

   ElseIf ActiveCell.Value = Text3 Then                    'Wenn BeU = OK9, die ganze Zeile löschen
       Selection.EntireRow.Delete
   
    Else                                                    'du nösing (nächste Zeile ohne löschen)

   End If
Next i

Ein kleines Beispiel habe ich beigefügt. Es geht um die Spalte T, in der der zu suchende Text ist.
  BeispMedDaten.xlsx (Größe: 22,77 KB / Downloads: 5)  

Kann mir jemand helfen? Vielen Dank im Voraus.

Viele Grüsse aus der kalten Schweiz
Rodlof

[Fennek]

Hallo,

für eine einmalige Aktion erscheint mir ein Ansatz von Hand geeignet:

- falls die jetzige Reihenfolge wichtig ist, in der ersten leeren Spalte "=zeile()" und mit autofill/doppelklick auf den ganzen Datensatz anwenden. Mit copy/ paste value die Formeln durch Werte ersetzen.

- in der nächsten leeren Spalte die Formel
=links(T5, 2) = "ok"

und ebenfalls mit doppellklick auf alle Zeilen anwenden
Danach nach dieser Spalte sortieren und alle "wahr" Zeilen löschen. Erneut nach der Spalte mit den ursprünglichen Zeilennummern sortieren.

mfg

[GMG-CC]

Moin,
ich bin mir nicht sicher, ob die kompletten OK-Blöcke gelöscht werden sollen oder jeweils die erste Zeile stehen bleiben soll. 
What ever, es geht mit Power Query rasch und zuverlässig.

[rodlof]

Hallo 

Wow! geht das fix hier!

Also die Reihenfolge ist schon wichtig, die muss beibehalten werden. Es ist auch keine einmalige Aktion. es sind mehrere Files und ich habe das letztes Jahr so gelöst mit den Einzelschritten. Nun trifft mich das Problem wieder und ich habe gedacht, dass ich es diesmal besser machen wollte.

Es müssen alle Zeilen mit "OK..." gelöscht werden. Die Beurteilung erfolgt auf der ersten Zeile eines Blocks, diese wird für alle in diesem Block dann mit einer absoluten Formel (auch per VGA eingetragen) auf alle Zeilen des Blockes angewandt. Die erste Zeile, die ich nicht löschen darf, ist die wirklich erste Zeile des gesamten Files unterhalb des Headers. Die kann ich nicht löschen, weil ich darauf Formeln verlinkt habe, die ich dann relativ auf die anderen Zeilen anwende (auch per VBA). 

Nun, was meinst du denn mit mit Power Queries?

Viele Grüsse und danke vielmals
Rodlof

[GMG-CC]

Moin,
dann sollte das angehängte File das Wunschergebnis enthalten.
Mit Power Query in wenigen Sekunden und (nur) einigen Mausklicks erledigt.

[rodlof]

Lieber Günther

Vielen Dank für die schnelle Antwort. Das File enthält tatsächlich das gewünschte Resultat. Allerdings muss ich hier mit den Standard Werkzeugen von Excel arbeiten. Power Query ist nicht vorgesehen.

Vielleicht hat ja noch jemand eine gute VBA Lösung parat?

Viele Grüsse
Rodlof

[GMG-CC]

Moin Rodolf,
ich weiß, dass ich gehässig bin   Power Query, -> http://www.excel-ist-sexy.de/power-query-das-add-in/ ist ein Standard-Add-In für Excel von MS!
Was ich allgemein über selbstherrliche IT-ler denke siehe hier. Traurig, traurig, dass gerade in solch einer Phase der Umwälzung denjenigen, die am Ende der Nahrungskette sitzen auch noch das letzte Fleisch vom Knochen abgeschabt wird ...

Vielleicht hilft dir ja dieser Link etwas weiter ... : http://www.excel-ist-sexy.de/transponieren-spezial/

[Kuwer]

Hallo Rodlof,

Vielleicht hat ja noch jemand eine gute VBA Lösung parat?

hier eine Variante, die die Liste per erweitertem Filter (früher Spezialfilter) in ein neues Blatt filtert:

Sub ListeFiltern()
 Dim oWs As Worksheet
 Dim rngQ As Range
 
 Set rngQ = ActiveSheet.Range("A4")
 Set rngQ = Range(rngQ, rngQ.SpecialCells(xlLastCell))

 Set oWs = Worksheets.Add(After:=rngQ.Parent)
 rngQ.Rows(1).Copy oWs.Cells(1)
 oWs.Cells(2, rngQ.Columns.Count).Formula = "<>OK*"
 
 rngQ.AdvancedFilter _
    Action:=xlFilterCopy, _
    CriteriaRange:=oWs.Cells(1).Resize(2, rngQ.Columns.Count), _
    CopyToRange:=oWs.Cells(4, 1), _
    Unique:=False
    
 oWs.Rows("1:3").Delete
End Sub

Gruß Uwe

[rodlof]

Hallo Uwe
Vielen Dank erst Mal für deinen Lösungsansatz. Das werde ich ausprobieren und gebe wieder Bescheid.
Liebe Grüsse
Rodlof

[rodlof]

Lieber Günther
Ja, ich habe deinen Blog gelesen. Tut mir leid wenn du enttäuscht bist von dieser neuen Welt.

Zu PQ: Ich arbeite beim Kanton und ich bin schon froh, dass ich überhaupt die Erlaubnis habe, VBA ausführen zu dürfen. Für ein zusätzliches Add In müsste ich hier zuerst Himmel und Hölle bewegen, damit eine Ausnahme gewährt werden kann. Aber ev. warte ich einfach auf die neue Version 2016, die wir ja auch irgendwann einführen werden. Das kann aber noch dauern. Ich kann dann nur hoffen, dass nicht alle Zusatzfunktionen gesperrt werden.

Du siehst, auch andere Menschen haben mit der Realität zu kämpfen.
In diesem Sinne viele Grüsse und Kopf hoch
Rodlof