Sub XXX()
Dim Datum As Variant
Dim Fundstelle As Range
Datum = Worksheets("Kalender").Range("C2").Value 'Wert auslesen
Do
Set Fundstelle = Worksheets("Kalender").Range("A1:A365").Find(Datum, LookIn:=xlValues, LookAt:=xlWhole) 'nach Wert suchen
If Fundstelle Is Nothing Then
Exit Do
End If
Fundstelle.Offset(0, 1).Value = Worksheets("Kalender").Range("D2").Value
If Int(Worksheets("Kalender").Range("E2").Value) > 0 Then
Datum = DateAdd("d", Int(Worksheets("Kalender").Range("E2").Value), Datum)
Else
Exit Do
End If
Loop
End Sub
Verläßt die Schleife sobald nichts mehr gefunden wurde.
Falls es manche Daten in der Liste nicht gibt - deinem Beispiel folgend z.B. 01.01.2021 / 15.01.2021 / 29.01.2021 - und du dennoch alle anderen berücksichtigen haben willst, dann könntest du die Schleife über die Bedingung, dass sich das Jahr in Datum ändert, verlassen (anstatt Fundstelle Is Nothing).
Grüße
|