Zweite Leere Zeile löschen

Forumthread: Zweite Leere Zeile löschen

30.07.2015 11:29:05

Benji

Hallo zusammen,
wie man eine leere Zeile löscht, ist mir bewusst.


Sub LeereZeilenLoeschen()
Dim i As Long
Application.ScreenUpdating = False
For i = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
If Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
End If
If i Mod 100 = 0 Then
Application.StatusBar = i
End If
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Ich möchte die erste leere Zeile behalten und alle weiteren löschen. Wenn zwischendrin Text ist, soller wieder die erste Leere Zeile behalten.
Vorher:

1 a
2
3
4 d
5
6 f
7
8
9 b

Nachher:

1 a
2
4 d
5
6 f
7
9 b

Zeilen 3 und 8 wurden gelöscht. Kann man dies mittels VBA umsetzen ?

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zweite Leere Zeile löschen

30.07.2015 11:48:37

EtoPHG
AW: Zweite Leere Zeile löschen

30.07.2015 11:49:14

Michael
AW: Zweite Leere Zeile löschen

30.07.2015 12:13:53

Daniel

AW: Zweite Leere Zeile löschen

30.07.2015 11:48:37

EtoPHG

Hallo Benji,
so:

Sub MehrfachLeereZeilenLoeschen()
Dim i As Long
Application.ScreenUpdating = False
For i = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row To 2 Step -1
If Application.WorksheetFunction.CountA(Rows(i - 1)) = 0 And _
Application.WorksheetFunction.CountA(Rows(i)) = 0 Then
Rows(i).Delete
End If
If i Mod 100 = 0 Then
Application.StatusBar = i
End If
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Gruess Hansueli

AW: Zweite Leere Zeile löschen

30.07.2015 11:49:14

Michael

Hi Benji,
versuch's mal damit:

Sub LeereZeilenLoeschen()
Dim i As Long
Dim unterste As Long, erste As Long, zweite As Long
unterste = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
Application.ScreenUpdating = False
zweite = Application.WorksheetFunction.CountA(Rows(unterste))
For i = unterste To 2 Step -1      ' Ende auf 2 geändert
erste = Application.WorksheetFunction.CountA(Rows(i - 1))
If erste = 0 And zweite = 0 Then
Rows(i).Delete
End If
If i Mod 100 = 0 Then
Application.StatusBar = i
End If
zweite = erste
Next i
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Schöne Grüße,
Michael

AW: Zweite Leere Zeile löschen

30.07.2015 12:13:53

Daniel

Hi
bei echten Leerzeilen und wenn es reicht eine Spalte zu prüfen:
dim Bereich as range

For Each Bereich in Columns(1).SpecialCells(xlcelltypeblanks).Areas
if Bereich.Cells.Count > 1 _
Bereich.Offset(1, 0).Resize(Bereich.Cells.Count -1, 1).EntireRow.Delete
next

ohne VBA gäbs auch noch ne einfache Lösung:
1. schreibe in die erste freie Zeile am Tabellenende in Zeile 2 die Formel:

=Wenn(Oder(A1"";A2"");Zeile();0)

und ziehe die Formel bis ans Tabellenende runter
2. schreibe in die Zeile 1 der Hilfsspalte die Zahl 0
3. wende jetzt auf die ganze Tabelle die Funktioin DATEN - DATENTOOLS - DUPLIKATE ENTFERNEN an, mit der Hilfsspalte als kriterium und und der Option ganze ohne Überschrift
das ganze geht natürlich auch als Makro (hier mit einer Formel, die die ganze zeile auf "leer" prüft:

Sub test()
With ActiveSheet.UsedRange
With .Columns(.Columns.Count + 1)
.Offset(1, 0).Resize(.Rows.Count - 1, 1).FormulaR1C1 = _
"=IF(CountA(R[-1]C1:RC[-1])=0,0,Row())"
.Cells(1, 1).Value = 0
.EntireRow.RemoveDuplicates .Column, xlNo
.ClearContents
End With
End With
End Sub

Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Forumthread: Zweite Leere Zeile löschen

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread