bestimmte Zeilen löschen

nachfolgendes Problem.

In Spalte A wird ab A7 abwärts bis zur ersten leeren Zelle geprüft,
ob in der Zelle eine Formel steht.

Das funkioniert bestens!

Zusätzlich möchte ich nun auch in Spalte B (analog zu Spalte A) prüfen,
ob eine Formel drinsteht.

Beispiel:

In A13 wird eine Formel gefunden.
Nun soll geprüft werden, ob die rechte Nebenzelle (hier B13) eine
Formel enthält.

Wird nur in A13 eine Formel gefunden, dann B13:F13 Werte löschen!

Wird in A13 + B13 eine Formel gefunden, dann C13:F13 Werte löschen!

Das ist der momentane Code:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="bulls23"

Dim i As Integer
    On Error Resume Next
    i = 7
    
    Do Until IsEmpty(Cells(i, 1))
     If Cells(i, 1).HasFormula Then
     Range(Cells(i, 2), Cells(i, 6)).ClearContents
      Else
      Rows(i).Select
      Selection.EntireRow.Delete
      i = i - 1
      End If
      i = i + 1
    Loop
    Cells(3, 3).Activate
    Application.ScreenUpdating = True
    ActiveSheet.Protect
End Sub

Vielen Dank
MikeS

Hallo Mike,

der Code könnte etwa so aussehen:

Private Sub CommandButton1_Click()
   Dim intRow As Integer
   Application.ScreenUpdating = False
   ActiveSheet.Unprotect Password:="bulls23"
   On Error Resume Next
   intRow = 7
   While Cells(intRow, 1) <> ""
      If Cells(intRow, 1).HasFormula Then
         If Cells(intRow, 2).HasFormula Then
            Range(Cells(intRow, 3), Cells(intRow, 6)).ClearContents
         Else
            Range(Cells(intRow, 2), Cells(intRow, 6)).ClearContents
         End If
         intRow = intRow + 1
      Else
         Rows(intRow).EntireRow.Delete
      End If
   Wend
   'Merke, On Error immer zurücksetzen.
   On Error GoTo 0
   Application.ScreenUpdating = True
   ActiveSheet.Protect
End Sub

Gruss
Markus

Danke, klappt wie gewünscht.
von: MikeS
Geschrieben am: 08.05.2002 - 08:28:58

Hallo Markus,

danke für die Codeergänzung/-umstellung, funktioniert perfekt!

Ciao Mike