|
Hallo zusammen,
@Hoddel, was ist dir denn für ne Laus über die Leber gelaufen? Das geht auch etwas freundlicher :-)
@Thomas. Hab deinen Code mal leicht modifiziert. Probier ihn aus:
Sub Anlegen()
Dim vDay As Variant
Dim iRow As Integer, lDay As Long, monat As Byte, x As Byte, k As Byte
monat = 1
If Weekday(DateSerial(Range("C1").Value, 1, 1)) Mod 2 = 1 And Weekday(DateSerial(Range("C1").Value, 1, 1)) < 7 Then k = 1
For lDay = DateSerial(Range("C1").Value, 1, 1) - k To DateSerial(Range("C1").Value, 12, 31) Step 2
If Weekday(lDay) = 6 Then
If IsError(Application.Match(lDay, Columns(1), 0)) Then
If Month(CDate(lDay)) = monat Then x = x + 1 Else x = 1
monat = Month(CDate(lDay))
If x = 3 Then
lDay = lDay + 7
x = 0
End If
iRow = iRow + 1
If Year(lDay) = Range("C1") Then
Cells(iRow, 6).Value = CDate(lDay)
Cells(iRow, 5).Value = Format(lDay, "dddd")
End If
End If
End If
Next lDay
End Sub
Gruß Mr. K.
|