Office: Zeile löschen wenn Bedingung erfüllt

mücke · 22. November 2008

Hallo Zusammen,

stehe mal wieder vor einem Rätsel.

Ich möchte in einer Tabelle nach LEEREN Zeilen suchen und diese dann löschen. Funktioniert auch mit folgendem CODE echt prima, bis auf eine kleine Kleinlichkeit.
Code:

Sub TestLeerZeilenLöschen()
Dim i As Long
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).Delete
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Da in den Spalten A und B teilweise noch Zeichen wie * oder # stehen, werden diese natürlich nicht mit gelöscht.
Nun habe ich versucht eine Abfrage in den CODE zu integrieren (der mein Problem löst) und bin gescheitert.
Meine Abfrage sollte eigentlich so aussehen.
Wenn Zeile Leer, dann Zeile löschen,
wenn in Spalte A ein * steht, dann Zeile löschen
wenn in Spalte B eine # steht, dann Zeile löschen

Krieg ich aber leider nicht hin. Kann mir bitte jemand helfen.
Schon mal vielen Dank
Gruß Mücke

:)

jinx · 24. November 2008

Moin, Mücke,

wenn es denn wirklich die beschriebenen Zeichen in den Spalten A und B sindsind:

Code:

Sub TestLeerZeilenLöschen()
Dim i As Long
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Or _
Cells(i, "A").Value = "*" Or _
Cells(i, "B").Value = "#" Then Rows(i).Delete
Next i
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

chris-kaiser · 24. November 2008

hiho

oder falls wirklich nur gelöscht werden sollte wenn ein Eintrag in den Zellen ist

Code:

Sub TestLeerZeilenLöschen()
Dim i As Long
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
ElseIf WorksheetFunction.CountA(Rows(i)) = 1 And (Cells(i, 1).Value = "*" Or Cells(i, 2).Value = "#") Then
Rows(i).Delete
End If
Next
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mücke · 24. November 2008

Hallo jinx,
hallo chris-kaiser,

vielen Dank EUCH BEIDEN *Smilie
Funktioniert prima!

@jinx: ja, es sind wirklich die Zeichen * und # !
Kleine Erläuterung.
Die Daten in Excel beruhen auf einem Report aus SAP der standartmäßig leider mit Zwischensummen arbeitet. Diese Ergebnisse werden durch Excel mit * und # dargestellt.

Nur für den Fall wenn...
... ich auch Leere Spalten suchen und löschen möchte.
Wie müsste ich diese Erweiterung in den CODE mit einbringen?!

Gruß Mücke

chris-kaiser · 24. November 2008

hi

Code:

Sub TestLeerZeilenLöschen()
Dim i As Long
Dim spalte As Range
Dim thebigone As Range
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
ElseIf WorksheetFunction.CountA(Rows(i)) = 1 And (Cells(i, 1).Value = "*" Or Cells(i, 2).Value = "#") Then
Rows(i).Delete
End If
Next
For Each spalte In ActiveSheet.UsedRange.Columns
If WorksheetFunction.CountA(spalte) = 0 Then
If thebigone Is Nothing Then
Set thebigone = spalte
Else
Set thebigone = Union(thebigone, spalte)
End If
End If
Next
thebigone.Delete
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mücke · 24. November 2008

Guten Morgen Chris,

die Erweiterung klappt einwandfrei! *Smilie
Vielen Dank!
Da ich den CODE auch gerne verstehen möchte, könntest du ihn BITTE kommentieren?! Wo für steht thebigone?
Für DEINE Bemühungen schon mal vielen Dank

Gruß Mücke

chris-kaiser · 24. November 2008

Hallo mücke

ich fasse damit Breiche zusammen
die Laufzeit reduziert sich damit um das zigfache

in der Variante die bei den Zeilen gemacht worden ist wird Zeile für Zeile einzeln gelöscht.

im Democode habe ich jetzt auch die Zeilen als Bereich zusammenverkettet

teste einmal 1000 zeilen einzeln löschen und danach den Democode mit "aufeinmallöschen" Du wirst überascht sein welcher Zeitunterschied das ist. *Smilie

Code:

Option Explicit
Sub TestLeerZeilenLöschen_version_eins_mit_function()
Dim i As Long
Dim spalte As Range, bigRange As Range
Dim thebigone As Range
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountA(Rows(i)) = 0 Then
bigRange = CreateTheBigone(Rows(i), bigRange) 'funktionsaufruf
ElseIf WorksheetFunction.CountA(Rows(i)) = 1 And (Cells(i, 1).Value = "*" Or Cells(i, 2).Value = "#") Then
bigRange = CreateTheBigone(Rows(i), bigRange) 'funktionsaufruf
End If
Next
If Not bigRange Is Nothing Then bigRange.Delete 'das habe ich noch erweitert ->falls keine Zellen gefunden worden sind das kein LFZ auftritt
End Sub

Function CreateTheBigone(zeile As Range, theBig As Range) As Range
If theBig Is Nothing Then 'wenn noch kein Bereich ist setze einmal die jeweilige Zeile
Set theBig = zeile
Else
Set theBig = Union(theBig, zeile) 'ansonsten zu dem bestehenden Bereich die nächste Zeile hinzufügen
End If
Set CreateTheBigone = theBig 'übergabe an die Function
End Function
'*******************************************+
'hier noch eine Variante ohne Function_wobei_wenn_mehrere Kriterien wären die function sicher besser wäre
Sub TestLeerZeilenLöschen_version_zwei_ohne_function()
Dim i As Long
Dim spalte As Range, bigRange As Range
Dim thebigone As Range
For i = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1 'jetzt könnte die Schleife auch mit 1 beginnen
If WorksheetFunction.CountA(Rows(i)) = 0 Then
If bigRange Is Nothing Then
Set bigRange = Rows(i) 'wenn noch kein Bereich ist setze einmal die jeweilige Zeile in den Bereich
Else
Set bigRange = Union(bigRange, Rows(i)) 'ansonsten zu dem bestehenden Bereich die nächste Zeile hinzufügen
End If
ElseIf WorksheetFunction.CountA(Rows(i)) = 1 And (Cells(i, 1).Value = "*" Or Cells(i, 2).Value = "#") Then
If bigRange Is Nothing Then '
Set bigRange = Rows(i)
Else
Set bigRange = Union(bigRange, Rows(i))
End If
End If
Next
If Not bigRange Is Nothing Then bigRange.Delete
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

mücke · 25. November 2008

Hallo Chris,

ich bin sprachlos! *boah
Werde die Varianten mal testen und melde mich dann wieder.

Vielen, vielen Dank

Gruß Mücke

Office: Zeile löschen wenn Bedingung erfüllt

Zeile löschen wenn Bedingung erfüllt

Zeile löschen wenn Bedingung erfüllt

Zeile löschen wenn Bedingung erfüllt

Zeile löschen wenn Bedingung erfüllt

Zeile löschen wenn Bedingung erfüllt - Similar Threads - Zeile löschen Bedingung

Zeilen verschieben/löschen wenn Bedingung erfüllt wurde

VBA - Zeilen je nach Bedingung in neues Tabellenblatt verschieben und löschen

Zeilen löschen wenn Bedingung erfüllt

Zeile löschen wenn Bedingung erfüllt

VBA - Zeile löschen bei mehreren IF-And Bedingungen

VBA - Zeile kopieren und löschen wenn Bedingung erfüllt ist

Zeilen unter bestimmten Bedingungen löschen