Zellbereiche löschen

Home Zurück Vor

Download der Beispiel-Arbeitsmappe

Gruppe

Allgemein

Bereich

Bereich

Thema

Zellbereiche löschen

Problem

Eine Reihe von Beispielen zum Löschen oder Leeren von Zellbereichen nach verschiedenen Kriterien.

Lösung

Geben Sie den Code in ein Standardmodul ein und weisen die einzelnen Prozeduren Schaltflächen zu.




StandardModule: basMain

' 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

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

' FehlerZellen löschen

Sub ClearErrorCells()
   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