21.08.2020, 18:08
Seiten: 1 2
22.08.2020, 09:36
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
leider darf ich auf den PC nix downloaden, da es ein Firmen PC ist.
Dank dir dennoch für deine Hilfe.
Gruß
Aritmatos
22.08.2020, 10:51
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 Sub22.08.2020, 18:57
Hallo,
oder so (ungetestet)
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 Sub23.08.2020, 10:08
Hallo,
ich habe bemerkt, dass ich noch einen Fehler drin habe
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 Sub24.08.2020, 17:39
Danke an alle.
bei mir haben beide Lösungen gearbeitet.
Gruß
Aritmatos
bei mir haben beide Lösungen gearbeitet.
Gruß
Aritmatos
24.08.2020, 17:45
Danke für die Rückmeldung
Seiten: 1 2