HERBERS Excel-Forum - VBA-Basics

Thema: Das Leeren und Löschen von Zellen

Inhaltsverzeichnis
  • 1 Löschen aller leeren Zellen einer Spalte
  • 2 Löschen der Zeile, wenn Zelle in Spalte A leer ist
  • 3 Löschen aller leeren Zeilen
  • 4 FehlerZellen leeren
  • 5 FehlerZellen löschen
  • 6 Löschen aller Zellen in Spalte A mit "hallo" im Text
  • 7 Leeren aller Zelle mit gelbem Hintergrund
  • 8 Alle leeren Zellen löschen
  • Löschen aller leeren Zellen einer Spalte

    
    Sub DeleteEmptyCells()
       Dim intLastRow As Integer
       Dim intRow As Integer
       intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
       For intRow = intLastRow To 1 Step -1
          If Application.CountA(Rows(intRow)) = 0 Then
             intLastRow = intLastRow - 1
          Else
             Exit For
          End If
       Next intRow
       For intRow = intLastRow To 1 Step -1
          If IsEmpty(Cells(intRow, 1)) Then
             Cells(intRow, 1).Delete xlShiftUp
          End If
       Next intRow
    End Sub
    

    Löschen der Zeile, wenn Zelle in Spalte A leer ist

    
    Sub DeleteRowIfEmptyCell()
       Dim intRow As Integer, intLastRow As Integer
       intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
       For intRow = intLastRow To 1 Step -1
          If Application.CountA(Rows(intRow)) = 0 Then
             intLastRow = intLastRow - 1
          Else
             Exit For
          End If
       Next intRow
       For intRow = intLastRow To 1 Step -1
          If IsEmpty(Cells(intRow, 1)) Then
             Rows(intRow).Delete
          End If
       Next intRow
    End Sub
    

    Löschen aller leeren Zeilen

    
    Sub DeleteEmptyRows()
       Dim intRow As Integer, intLastRow As Integer
       intLastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
       For intRow = intLastRow To 1 Step -1
          If Application.CountA(Rows(intRow)) = 0 Then
             Rows(intRow).Delete
          End If
       Next intRow
    End Sub
    

    FehlerZellen leeren

    
    SubClearContentsErrorCells()
       On Error GoTo ERRORHANDLER
       Cells.SpecialCells(xlCellTypeFormulas, 16).ClearContents
    ERRORHANDLER:
    End Sub
    

    FehlerZellen löschen

    
    SubClearErrorCells()
       On Error GoTo ERRORHANDLER
       Cells.SpecialCells(xlCellTypeFormulas, 16).Delete xlShiftUp
    ERRORHANDLER:
    End Sub
    

    Löschen aller Zellen in Spalte A mit "hallo" im Text

    
    Sub DeleteQueryCells()
       Dim var As Variant
       Do While Not IsError(var)
          var = Application.Match("hallo", Columns(1), 0)
          If Not IsError(var) Then Cells(var, 1).Delete xlShiftUp
       Loop
    End Sub
    

    Leeren aller Zelle mit gelbem Hintergrund

    
    Sub ClearYellowCells()
       Dim rng As Range
       For Each rng In ActiveSheet.UsedRange
          If rng.Interior.ColorIndex = 6 Then
             rng.ClearContents
          End If
       Next rng
    End Sub
    

    Alle leeren Zellen löschen

    
    Sub DeleteEmptys()
       Dim rng As Range
       Application.ScreenUpdating = False
       For Each rng In ActiveSheet.UsedRange
          If IsEmpty(rng) Then rng.Delete xlShiftUp
       Next rng
       Application.ScreenUpdating = True
    End Sub