PDA

Vollständige Version anzeigen : leerzeilen löschen


Dari
28.06.2006, 08:16
Hi,

ich habe in meiner exceltabelle immer mal wieder mehrere leerzeilen (4 Stück) zwischen dem eigentlichen inhalt.
weiß jemand eine möglichkeit alle bis auf eine automatisch per makro löschen zu lassen. habe bis jetzt nur die variante gefunden wirklich alle zu löschen:

Sub Leerzeilen_löschen()
Range("A1:A65536").SpecialCells(xlCellTypeBlanks). _
EntireRow.Delete
End Sub


Grüße

Schmali
28.06.2006, 09:05
Hi Dari,

Dim i As Integer
Sub leerzeilen()
i = Cells(Cells.Rows.Count, 1).End(xlUp).Row
Range("A1:A" & i).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub


wäre ne Möglichkeit. das Makro sucht nach der letzten beschriebenen Zelle in Spalte A und löscht dann die Leerzeilen in diesem Bereich. Die von Dir gepostet Variante geht immer alle Zeilen von 1 bis 65536 durch und braucht in der Ausführung länger.

Greetz

Schmali

Woody
28.06.2006, 09:09
Hallo Dan,

ich bin mir sicher die Forumssuche fördert einiges zum Thema zu Tage. Irgendwann /-wo habe ich mal dieses Makro (von jinx glaube ich) notiert, das sich bei anderen Kriterien leicht anpassen läßt.

Sub LeereZeilenLöschen()
'
Dim lR As Long
Dim i As Long
Dim Krit As Boolean
Dim Wert As String
Application.ScreenUpdating = False
lR = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For i = lR To 1 Step -1
Krit = False
Wert = Cells(i, 1).Value '(.., 1) bedeutet 1=Spalte A.
Select Case Wert
Case "" 'wenn Zelle leer
Krit = True
Case Else
Krit = False
End Select
If Krit Then
Rows(i).Delete
End If
Next i
Application.ScreenUpdating = True
End Sub

@Schmali:
ich würde die Zeilenvariable zur Sicherheit immer als Long definieren.

Nachtrag: Es wird bei Dir nur ein zusammenhängender Bereich mit leeren Zellen gelöscht, ab A1 beginnend, ich glaube das hilft Dan nicht weiter. Eine Schleife zum Durchlaufen der Zeilen ist sinnvoller.

MRR
28.06.2006, 09:47
Wenn wirklich zwischen einigen gefüllten Zeilen noch EINE Leerzeile übrig bleiben soll:

Sub Loesche_Leerzeilen()
Dim i As Long
Dim j As Integer
Dim lastRow As Long
Dim lastCol As Integer
Dim blnLeer As Boolean
lastRow = Cells(Cells.Rows.Count, 1).End(xlUp).Row
lastCol = Cells(Cells.Columns.Count, 1).End(xlToRight).Column

For i = lastRow To 2 Step -1
blnLeer = True
For j = 1 To lastCol
If Cells(i, j) <> "" Then
blnLeer = False
Exit For
End If
Next
If blnLeer Then
For j = 1 To lastCol 'Vorherige Zeile prüfen
If Cells(i - 1, j) <> "" Then
blnLeer = False
Exit For
End If
Next
If blnLeer Then
Cells(i, 1).EntireRow.Delete xlShiftUp
End If
End If
Next
End Sub