Markierung von Urlaubstagen

Einen schönen guten Tag allerseits
Nach langem, erfolglosen Suchen in diversen Foren und Beiträgen sehe ich ein, das ich ohne Hilfe nicht weiterkomme.
In meiner Arbeitsmappe gibt es unter anderem die Blätter "Kalender", "Blatt 01", "Blatt 02" usw. bis max. "Blatt 53" (jede Woche wird über ein Makro ein neues Blatt erstellt) sowie das Blatt "Feiertage". In diesem Blatt existiert ein Bereich "Feiertage" mit Bezug auf die Zellen AA5:AA19.
Das Blatt "Kalender" enthält einen Jahreskalender - analog zum "Schnellkalender" aus den "EXCELFORMELN", jedoch mit Angabe der Kalenderwochen - sowie eine monatliche Übersicht mit den geleisteten Arbeitsstunden, Überstunden, Urlaubstagen, Krankheitstagen etc. In dem Jahreskalender sind die Wochenenden und Feiertage farblich hervorgehoben (bedingte Formatierung).
Die einzelnen Blätter "Blatt xx" haben (schematisch) folgenden Aufbau.
Datum Schlüsselwort Tätigkeit Beginn Ende ... ... ...
02.01.2013 Anwesend (Beschreibung) 07:15 13:30
(Beschreibung) 13:30 15:00
(Beschreibung) 15:00 17:00
03.01.2013 Anwesend (Beschreibung) 06:45 13:30
(Beschreibung) 13:30 15:30
04.01.2013 Urlaub
05.01.2013 Anwesend (Beschreibung) 06:30 16:15

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,

Sub Zeiten()
Dim wks As Worksheet, rngC As Range
Dim objUrlaub As Object, objFehl As Object, objKrank As Object
Set objUrlaub = CreateObject("Scripting.Dictionary")
Set objFehl = CreateObject("Scripting.Dictionary")
Set objKrank = CreateObject("Scripting.Dictionary")
For Each wks In Worksheets
If wks.Name Like "Bl.*" Then
With wks
For Each rngC In .Range(.Cells(3, 15), .Cells(Rows.Count, 15).End(xlUp))
Select Case rngC
Case "Urlaub"
objUrlaub(objUrlaub.Count) = rngC.Offset(, 1).Value
Case "Fehlzeit"
objFehl(objFehl.Count) = rngC.Offset(, 1).Value
Case "Krank"
objKrank(objKrank.Count) = rngC.Offset(, 1).Value
End Select
Next
End With
End If
Next
With Sheets("Hilfstabelle")
.Range(.Cells(10, 11), .Cells(10, 11).End(xlDown)).Clear
.Cells(10, 11).Resize(objUrlaub.Count) = WorksheetFunction.Transpose(objUrlaub.items)
.Range(.Cells(10, 12), .Cells(10, 12).End(xlDown)).Clear
.Cells(10, 12).Resize(objFehl.Count) = WorksheetFunction.Transpose(objFehl.items)
.Range(.Cells(10, 13), .Cells(10, 13).End(xlDown)).Clear
.Cells(10, 13).Resize(objKrank.Count) = WorksheetFunction.Transpose(objKrank.items)
End With
End Sub

Gruß
Rudi

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread