Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("C2:C1000"), Target) Is Nothing Then
Call setIntervall(Target)
End If
End Sub
Sub setzealle()
Dim i
For i = 2 To 1000
Call setIntervall(Cells(i, "C"))
Next
End Sub
Sub setIntervall(rng As Range)
Dim bolhj As Boolean
Dim dtDatum As Date
Dim interv As Double, lastcol&, i&
Dim res
Dim strHJ As String
interv = rng.Value
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
If interv > 0 Then
dtDatum = rng.Offset(0, -1).Value
If Month(dtDatum) <= 6 Then
strHJ = "1.Halbjahr " & Year(dtDatum)
Else
strHJ = "2.Halbjahr " & Year(dtDatum)
End If
res = Application.Match(strHJ, Rows("1:1"), 0)
If IsNumeric(res) Then
Cells(rng.Row, 4).Resize(1, lastcol - 3).ClearContents
For i = res To lastcol Step interv * 2
Cells(rng.Row, i) = 1
Next
End If
Else
Cells(rng.Row, 4).Resize(1, lastcol - 3).ClearContents
End If
Application.EnableEvents = True
End Sub