|
erst Till, nun Dirk. Wie heissest du denn wirklich? Ist es so schlimm bei einem Namen zu bleiben?
Ich hab mein Makro mal umgebaut ,du kannst deine Spalte mit dem Makro setzealle() durcharbeiten lassen.
Ist aber ungetestet.
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
|