Thema
Urlaub gem. Tabelle in Urlaubsliste eintragen
Gruppe
Arbeitszeit
Problem
In einer Tabelle habe ich Mitarbeiternamen, Urlaubsbeginn und Urlaubsende stehen. Wie kann ich die Urlaubstage in den nachfolgenden Monatsblättern bei den einzelnen Mitarbeitern farblich markieren?
StandardModule: basMain
Sub UrlaubsEintrag()
Dim rng As Range
Dim iRow As Integer, iMonth As Integer, iCounter As Integer
iRow = 3
Do Until IsEmpty(Cells(iRow, 1))
For iMonth = Month(Cells(iRow, 2)) To Month(Cells(iRow, 3))
Set rng = Worksheets(Format(DateSerial(1, iMonth, 1), "mmmm")). _
Columns(1).Find _
(Cells(iRow, 1), LookIn:=xlValues, lookat:=xlWhole)
If iMonth = Month(Cells(iRow, 2)) And iMonth = _
Month(Cells(iRow, 3)) Then
For iCounter = Day(Cells(iRow, 2)) To Day(Cells(iRow, 3))
rng.Offset(0, iCounter).Interior.ColorIndex = 3
Next iCounter
ElseIf iMonth = Month(Cells(iRow, 2)) Then
For iCounter = Day(Cells(iRow, 2)) To Day(DateSerial _
(1, Month(Cells(iRow, 2)) + 1, 0))
rng.Offset(0, iCounter).Interior.ColorIndex = 3
Next iCounter
Else
For iCounter = 1 To Day(Cells(iRow, 3))
rng.Offset(0, iCounter).Interior.ColorIndex = 3
Next iCounter
End If
Next iMonth
iRow = iRow + 1
Loop
End Sub