Sub Termine()
Dim lngCounter As Long, DTermine As Long
Dim Lager As Date
Dim Eingabe As Integer, MTage As Integer
Do
Eingabe = InputBox("Eingabe der MonatsZahl bitte !")
Loop Until Eingabe > 0 And Eingabe < 13
ReDim Dat(Day(DateSerial(Year(Date), Eingabe + 1, 0)), 1) As String
Dim TagD() As Variant
For lngCounter = 0 To Day(DateSerial(Year(Date), Eingabe + 1, 0)) - 1
Dat(lngCounter, 0) = Format(DateSerial(Year(Date), Eingabe, lngCounter + 1), "DDD")
Dat(lngCounter, 1) = lngCounter + 1 & "." & Eingabe & "." & Year(Date)
Next lngCounter
Range("A:D").Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("C2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, Orientation:=xlTopToBottom
Range("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
TagD = Range("A2:A" & ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row)
Range("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=False
For DTermine = 1 To UBound(TagD())
Range("A1").AutoFilter Field:=1, Criteria1:=TagD(DTermine, 1)
For MTage = 0 To UBound(Dat())
For TTage = 1 To ActiveSheet.Range(Cells(Rows.Count, 1), Cells(Rows.Count, 1)).End(xlUp).Row
If Dat(MTage, 0) = Mid(TagD(DTermine, 1), 1, 2) Then
If Cells(TTage, 3) > Lager And Cells(TTage, 2) = "" Then
Cells(TTage, 2) = Dat(MTage, 1)
Lager = Cells(TTage, 4)
End If
End If
Next TTage
Lager = 0
Next MTage
Range("A1").AutoFilter
Next DTermine
End Sub
