PDA

Vollständige Version anzeigen : Zeile löschen wenn Bedingung erfüllt


mücke
24.11.2008, 15:09
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.
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
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.11.2008, 15:57
Moin, Mücke,

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

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

chris-kaiser
24.11.2008, 16:00
hiho

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

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

mücke
24.11.2008, 16:26
Hallo jinx,
hallo chris-kaiser,

vielen Dank EUCH BEIDEN :)
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.11.2008, 17:11
hi

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

mücke
25.11.2008, 07:57
Guten Morgen Chris,

die Erweiterung klappt einwandfrei! :)
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
25.11.2008, 10:45
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. :)


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

mücke
25.11.2008, 11:28
Hallo Chris,

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

Vielen, vielen Dank

Gruß Mücke