Private
Sub
Worksheet_Change(
ByVal
Target
As
Range)
Dim
LastRow
As
Long
Dim
i
As
Long
Dim
Name
As
String
Dim
Week
As
Integer
Dim
FirstDate
As
Date
Dim
Found
As
Boolean
Set
NewTarget = Intersect(Target, Range(
"A:A"
))
If
NewTarget
Is
Nothing
Then
Set
NewTarget = Intersect(Target, Range(
"L:L"
))
If
NewTarget
Is
Nothing
Then
Exit
Sub
Cells(Target.Row,
"M"
) = Now
Exit
Sub
End
If
If
Cells(Target.Row,
"A"
).Value <>
""
Then
Cells(Target.Row,
"C"
) = Now
Cells(Target.Row,
"D"
) = Now
Else
Cells(Target.Row,
"C"
) =
""
Cells(Target.Row,
"D"
) =
""
End
If
If
Target.Column <> 5
Then
Exit
Sub
LastRow = Cells(Rows.Count,
"E"
).
End
(xlUp).Row
For
i = Target.Row
To
LastRow
Name = Cells(i,
"E"
).Value
FirstDate = Cells(i,
"C"
).Value
Week = Format(FirstDate,
"ww"
)
Found =
False
For
j = 10
To
i - 1
If
Cells(j,
"E"
).Value = Name
And
Format(Cells(j,
"C"
).Value,
"ww"
) = Week
Then
Found =
True
Exit
For
End
If
Next
j
If
Not
Found
Then
Cells(i,
"J"
).Value =
"nötig "
End
If
Next
i
End
Sub