VBA Schleife

[snb]

Du brauchst kein Makro, nur ein Filter.

[Aritmatos]

Hallo snb,

leider darf ich auf den PC nix downloaden, da es ein Firmen PC ist.

Dank dir dennoch für deine Hilfe.

Gruß

Aritmatos

[ralf_b]

mal ein neuer versuch 

Code:

Sub prcAirtmatos2()

   Dim bereich As Range
   Dim zAnfang As Long, zEnde As Long, loletzte As Long, i As Long
   Dim spalte As Long, zeilenSprung As Long
       
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   
  loletzte = Cells(Rows.Count, 3).End(xlUp).Row
  zAnfang = 1
  spalte = 3
 
  For zeilenSprung = 1 To UsedRange.Rows.Count
       
       Set bereich = Range(Cells(zAnfang, spalte), Cells(loletzte, spalte)).Find("Debitoren Nr. ")
       if bereich is nothing then exit sub  'Abbruch wenn nichts gefunden wurde
       zAnfang = bereich.Row + 1
       
       Set bereich = Range(Cells(zAnfang, spalte), Cells(loletzte, spalte)).Find("Ergebnis")
       zEnde = bereich.Row - 1
           
        For i = 3 To UsedRange.Columns.Count - spalte Step 6
            Range(Cells(zAnfang, i), Cells(zEnde, i).Offset(0, 3)).Clear
        Next
     
        zeilenSprung = zEnde + 1
       
  Next zeilenSprung
 
  Application.ScreenUpdating = True
  Application.Calculation = xlCalculationAutomatic
  Set bereich = Nothing
End Sub

[Steffl]

Hallo,

oder so (ungetestet)

Code:

Sub prcAirtmatos()


   Dim bereich As Range, bereich1 As Range
   Dim zeile As Integer
   Dim spalte As Long '
   Dim strErsterTreffer As String
  
   Dim l?schZeile As Integer
   Dim l?schSpalte As Integer
  
   l?schSpalte = 4
  
  
   zeile = 5
   'spalte = 3
  
   For spalte = 3 To 15 Step 6
  
   Set bereich = Columns(spalte).Find("Debitoren Nr. ")
   zeile = bereich.Row + 1
  
   Set bereich1 = Columns(spalte).Find("Ergebnis")
      
   l?schZeile = bereich1.Row - 1
  
   strErsterTreffer = bereich.Address
  
   Do
      Cells(zeile, spalte).Resize(l?schZeile - zeile + 1, 4).Clear
      Set bereich = Columns(spalte).Find(bereich)
      Set bereich1 = Columns(spalte).Find(bereich1)
   Loop While strErsterTreffer <> bereich.Address
  
   Next spalte

End Sub

[Steffl]

Hallo,

ich habe bemerkt, dass ich noch einen Fehler drin habe

Code:

Sub prcAirtmatos()


   Dim bereich As Range, bereich1 As Range
   Dim zeile As Integer
   Dim spalte As Long '
   Dim strErsterTreffer As String
  
   Dim loeschZeile As Integer
   Dim loeschSpalte As Integer
  
   loeschSpalte = 4
  
  
   zeile = 5
   'spalte = 3
  
   For spalte = 3 To 15 Step 6
  
   Set bereich = Columns(spalte).Find("Debitoren Nr. ")

   Set bereich1 = Columns(spalte).Find("Ergebnis")
      
   strErsterTreffer = bereich.Address
  
   Do
      zeile = bereich.Row + 1
      loeschZeile = bereich1.Row - 1
      Cells(zeile, spalte).Resize(loeschZeile - zeile + 1, 4).Clear
      Set bereich = Columns(spalte).Find(bereich)
      Set bereich1 = Columns(spalte).Find(bereich1)
   Loop While strErsterTreffer <> bereich.Address
  
   Next spalte

End Sub

[Aritmatos]

Danke an alle.

bei mir haben beide Lösungen gearbeitet.

Gruß

Aritmatos

[ralf_b]

Danke für die Rückmeldung