Hallo Nico,
Eine Lösung...
Sub setze_X()
Dim Zeile As Long
Dim Spalte As Long
Dim Zeilen As Long
For Zeile = 12 To 2600
Spalte = 19 'Spalte "S"
If Cells(Zeile, Spalte) <> 0 Then 'Spalte "S" <> 0
If Cells(Zeile, Spalte - 4) = Cells(Zeile, Spalte) Then
Cells(Zeile + 1, Spalte + 6) = "x"
Cells(Zeile + 1, Spalte + 7) = ""
End If
If Cells(Zeile, Spalte - 3) = Cells(Zeile, Spalte) Then
For Zeilen = 1 To 2
Cells(Zeile + Zeilen, Spalte + 6) = "x"
Cells(Zeile + Zeilen, Spalte + 7) = ""
Next
End If
If Cells(Zeile, Spalte - 2) = Cells(Zeile, Spalte) Then
For Zeilen = 1 To 3
Cells(Zeile + Zeilen, Spalte + 6) = "x"
Cells(Zeile + Zeilen, Spalte + 7) = ""
Next
End If
If Cells(Zeile, Spalte - 1) = Cells(Zeile, Spalte) Then
For Zeilen = 1 To 5
Cells(Zeile + Zeilen, Spalte + 6) = "x"
Cells(Zeile + Zeilen, Spalte + 7) = ""
Next
End If
End If
Next
End Sub
ca. 12 Min. x ##00,00 EUR die Stunde, ist das OK?
Gruß Detlev
|