Hab mir das ganze nochmal angesehen, der erste Code verlässt das Makro, wenn es nicht in Spalte L ist, daher wird der Rest nicht mehr abgearbeitet. Das habe ich übersehen.
Versuch es mal so:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
Dim i As Long, j As Long
Dim Name As String
Dim Week As Integer
Dim FirstDate As Date
Dim Found As Boolean
Select Case Target.Column
Case 1 'Änderung in Spalte A
If Target.Value <> "" Then
Target.Offset(0, 2).Value = Now
Target.Offset(0, 3).Value = Now
Else
Target.Offset(0, 2).Value = ""
Target.Offset(0, 3).Value = ""
End If
Case 5 'Änderung in Spalte E
' Letzte Zeile in Spalte E finden
LastRow = Cells(Rows.Count, "E").End(xlUp).Row
' Für jede neue Zeile in Spalte E
For i = Target.Row To LastRow
' Name in Spalte E
Name = Cells(i, "E").Value
' Datum in Spalte C
FirstDate = Cells(i, "C").Value
' Kalenderwoche des Datums
Week = Format(FirstDate, "ww")
' Überprüfen, ob der Name bereits in dieser Kalenderwoche aufgetaucht ist
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
' Wenn der Name das erste Mal in dieser Kalenderwoche aufgetaucht ist
If Not Found Then
' Nachricht in Spalte J schreiben
Cells(i, "J").Value = "nötig "
End If
Next i
Case 12 'Änderung in Spalte L
Cells(Target.Row, "M") = Now
End Select
End Sub
|