Gruppe
DatumZeit
Problem
Wie kann ich einen 3-Schicht-Arbeitsplan unter Berücksichtigung variabler freier Tage und Markierung der Wochenenden erstellen?
StandardModule: Modul1
Sub ArbeitsPlan()
Dim datStart As Date
Dim datEnd As Date
Dim iFrei As Integer, iRow As Integer, iAct As Integer
Dim lDay As Long
datStart = Range("B1").Value
datEnd = Range("B2").Value
iFrei = Range("B3").Value
Workbooks.Add 1
Columns(1).NumberFormat = "dd.mm.yy"
Columns(2).NumberFormat = "dddd"
For lDay = datStart To datEnd
iRow = iRow + 1
Cells(iRow, 1) = datStart + iRow - 1
Cells(iRow, 2) = datStart + iRow - 1
If Application.WeekDay(datStart + iRow - 1, 2) > 5 Then
Cells(iRow, 1).Interior.ColorIndex = 6
Cells(iRow, 2).Interior.ColorIndex = 6
End If
iAct = iAct + 1
If iAct = 21 + iFrei * 3 Then iAct = 1
If iAct < 8 Then
Cells(iRow, 3) = "Früh"
ElseIf iAct < 8 + iFrei Then
Cells(iRow, 3) = "iFrei"
ElseIf iAct < 14 + iFrei Then
Cells(iRow, 3) = "Mittag"
ElseIf iAct < 14 + iFrei * 2 Then
Cells(iRow, 3) = "iFrei"
ElseIf iAct < 21 + iFrei * 2 Then
Cells(iRow, 3) = "Nacht"
ElseIf iAct < 21 + iFrei * 3 Then
Cells(iRow, 3) = "iFrei"
End If
Next lDay
End Sub