Zweite Leere Zeile löschen

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
MsgBox
Bild

Betrifft: Zweite Leere Zeile löschen
von: Benji
Geschrieben am: 31.07.2015 06:59:11

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 ?

    Bild

    Betrifft: AW: Zweite Leere Zeile löschen
    von: Luschi
    Geschrieben am: 31.07.2015 07:51:56
    Hallo Benji,
    ich mach das immer so:

    
    Sub LeereZeilenLoeschen()
        Dim rg As Range, i As Long
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Application.Calculation = xlCalculationManual
        
        With ActiveSheet
            For i = .Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1
                If i > 1 Then
                    'aktuelle und 1 Zeile davor müssen leer sein
                    If Application.WorksheetFunction.CountA(.Rows(i)) = 0 And _
                       Application.WorksheetFunction.CountA(.Rows(i - 1)) = 0 Then
                       
                       'erst alle leeren 'A?'-Zellen sammeln
                       If rg Is Nothing Then
                          Set rg = .Cells(i, 1)
                       Else
                          Set rg = Application.Union(rg, .Cells(i, 1))
                       End If
                    End If
                 End If
        '         If i Mod 100 = 0 Then
        '           Application.StatusBar = i
        '         End If
              Next i
        End With
        If Not rg Is Nothing Then
           'wenn es leere Zeilen gibt, erst jetzt mit 1 Befehl löschen
           rg.EntireRow.Delete
           Set rg = Nothing
        End If
          
        'Application.StatusBar = False
        Application.ScreenUpdating = True
        Application.EnableEvents = True
        Application.Calculation = xlCalculationAutomatic
        MsgBox "Fertig!", 48 + vbSystemModal
    End Sub
    Gruß von Luschi
    aus klein-Paris

    Bild

    Betrifft: Lösungen seit Tagen schon vorhanden!
    von: EtoPHG
    Geschrieben am: 31.07.2015 07:59:14
    Hallo Benji,
    Kontrollier die Antworten auf deine Erstanfrage und stopp das Zumüllen des Forums mit immer wieder der gleichen Anfrage!
    Gruess Hansueli

     Bild

    Beiträge aus den Excel-Beispielen zum Thema "Zweite Leere Zeile löschen"