VBA in Excel/ Leeren und Löschen von Zellen

|

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

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 Zellen 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

|

Hoch zu „Inhaltsverzeichnis“ |