VBA in Excel/ Leeren und Löschen von Zellen

Aus Wikibooks
Wechseln zu: Navigation, Suche
| One wikibook.svg Hoch zu „Inhaltsverzeichnis“ |


Löschen aller leeren Zellen einer Spalte[Bearbeiten]

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[Bearbeiten]

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[Bearbeiten]

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[Bearbeiten]

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

FehlerZellen löschen[Bearbeiten]

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[Bearbeiten]

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[Bearbeiten]

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[Bearbeiten]

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
| One wikibook.svg Hoch zu „Inhaltsverzeichnis“ |