|
Hallo Thomas,
das Programm könnte so aussehen (Freitage, die auf Feiertage fallen, werden auch hier weggelassen):
Sub Anlegen_Neu()
Dim aktMonat As Integer
Dim anzFreitage As Long
Dim iRow As Integer, lDay As Long
For lDay = DateSerial(Range("C1").Value, 1, 1) To DateSerial(Range("C1").Value, 12, 31)
If Weekday(lDay) = 6 Then
If aktMonat = Month(lDay) Then
anzFreitage = anzFreitage + 1
Else
aktMonat = Month(lDay)
anzFreitage = 1
End If
If IsError(Application.Match(lDay, Columns(1), 0)) Then
If anzFreitage = 1 Or anzFreitage = 3 Then
iRow = iRow + 1
Cells(iRow, "F").Value = CDate(lDay)
Cells(iRow, "E").Value = Format(lDay, "dddd")
End If
End If
End If
Next lDay
End Sub
Viele Grüße
Dieter
|