Für einen definierten Zeitraum: Nur Werk- bzw. Arbeitstage
Per Makro/VBA sollen für einen definierten Zeitraum alle Werk- oder Arbeitstage eingetragen werden. Unsere Definition: „Werktage” ist immer Montag bis Freitag, also auch der Karfreitag oder Pfingstmontag. Und natürlich auch die Weihnachtstage, sofern sie nicht am Wochenende sind. „Arbeitstage” sind grundsätzlich alle Werktage aber ohne die Feiertage.
Mittels der beiden folgenden Prozeduren wird im aktuellen Arbeitsblatt entweder senkrecht (Standard) oder waagerecht der entsprechende Datumsbereich ausgefüllt. Die Start-Zelle sowie das Format des Datums können im Code leicht angepasst werden.
Option Explicit
Option Base 1
Private Sub NurArbeitstage() 'Mo-Fr, Feiertage werden nicht geschrieben
Dim Start As Date, Ende As Date, Hor As Boolean
Dim Datum As Date, aDatum() As Long, AnzTage As Integer, z As Integer
Dim rngDatum As Range
Start = CDate("1.1.2016") 'Alternativ auch Zelle angeben
Ende = CDate("31.1.2016") '… und sonst natürlich anpassen
'Hor = True 'Nur falls die Daten waagerecht eingetragen werden sollen
ReDim aDatumAll(Ende - Start + 1)
'Anzahl der Arbeitstage für Array festlegen
For Datum = Start To Ende
If Weekday(Datum, vbMonday) < 6 Then
If Not Feiertag(Datum) Then
AnzTage = AnzTage + 1
End If
End If
Next Datum
'Array dimensionieren und Daten hinein schreiben
ReDim aDatum(AnzTage)
For Datum = Start To Ende
If Weekday(Datum, vbMonday) < 6 Then
If Not Feiertag(Datum) Then
z = z + 1
aDatum(z) = CLng(Datum)
End If
End If
Next Datum
'Start soll B1 (horizontal) bzw. A2 sein …
If Hor Then
Set rngDatum = Range("B1").Resize(, AnzTage)
rngDatum = aDatum
Else
Set rngDatum = Range("A2").Resize(AnzTage)
rngDatum = WorksheetFunction.Transpose(aDatum)
End If
rngDatum.NumberFormat = "DD/MM/YYYY"
End Sub
Private Sub NurWerktage() 'Mo-Fr, Feiertage sind Mo-Fr Arbeitstage
Dim Start As Date, Ende As Date, Hor As Boolean
Dim Datum As Date, aDatum() As Long, AnzTage As Integer, z As Integer
Dim rngDatum As Range
Start = CDate("1.1.2016") 'Alternativ auch Zelle angeben
Ende = CDate("31.1.2016") '… und sonst natürlich anpassen
'Hor = True 'Nur falls die Daten waagerecht eingetragen werden sollen
ReDim aDatum(Ende - Start + 1)
'Anzahl der Arbeitstage für Array festlegen
For Datum = Start To Ende
If Weekday(Datum, vbMonday) < 6 Then AnzTage = AnzTage + 1
Next Datum
'Array dimensionieren und Daten hinein schreiben
ReDim aDatum(AnzTage)
For Datum = Start To Ende
If Weekday(Datum, vbMonday) < 6 Then
z = z + 1
aDatum(z) = CLng(Datum)
End If
Next Datum
'Start soll B1 (horizontal) bzw. A2 sein …
If Hor Then
Set rngDatum = Range("B1").Resize(, AnzTage)
rngDatum = aDatum
Else
Set rngDatum = Range("A2").Resize(AnzTage)
rngDatum = WorksheetFunction.Transpose(aDatum)
End If
rngDatum.NumberFormat = "DD/MM/YYYY"
End Sub
Function Feiertag(Datum) As Boolean 'GMG-CC.de
Dim Jahr As Integer, Ostern As Date, Hl3Koenige As Date
Dim Neujahr As Date, Karfreitag As Date, OsterMontag As Date
Dim TagDerArbeit As Date, Pfingsten As Date, PfingstMontag As Date
Dim Himmelfahrt As Date, TagDerEinheit As Date, HeiligAbend As Date
Dim Weihnacht1 As Date, Weihnacht2 As Date, Silvester As Date
Dim Altweiber As Date, Rosenmontag As Date, Fronleichnam As Date
Dim MariaHimmelfahrt As Date, Reformationstag As Date, Allerheiligen As Date
'Bei Bedarf weitere Feiertage hier deklarieren
Jahr = Year(Datum)
'Bundes-einheitlich
Ostern = OsterSonntag(Jahr)
Neujahr = DateSerial(Jahr, 1, 1)
Karfreitag = Ostern - 2
OsterMontag = Ostern + 1
TagDerArbeit = DateSerial(Jahr, 5, 1)
Himmelfahrt = Ostern + 39
Pfingsten = Ostern + 49
PfingstMontag = Ostern + 50
TagDerEinheit = DateSerial(Jahr, 10, 3)
Weihnacht1 = DateSerial(Jahr, 12, 25)
Weihnacht2 = DateSerial(Jahr, 12, 26)
'Definitions-Frage
HeiligAbend = DateSerial(Jahr, 12, 24)
Silvester = DateSerial(Jahr, 12, 31)
'Regional bedingt
Hl3Koenige = DateSerial(Jahr, 1, 6)
Altweiber = Ostern - 52
Rosenmontag = Ostern - 48
Fronleichnam = Ostern + 60
MariaHimmelfahrt = DateSerial(Jahr, 8, 15)
Reformationstag = DateSerial(Jahr, 10, 31)
Allerheiligen = DateSerial(Jahr, 11, 1)
'Bei Bedarf weitere Feiertage hier initialisieren
Select Case Datum
Case Ostern, Neujahr, Karfreitag, OsterMontag, TagDerArbeit, _
Himmelfahrt, Pfingsten, PfingstMontag, TagDerEinheit, _
Weihnacht1, Weihnacht2
Feiertag = True
' Falls auch Feiertage, Kommentar-Marker in nächsen 2 Zeilen entfernen
' Case HeiligAbend, Silvester
' Feiertag = True
' Bei Bedarf noch weitere Feiertage nach diesem Muster hinzufügen
End Select
End Function
Function OsterSonntag(Jahr As Integer)
Dim d As Integer
d = (((255 - 11 * (Jahr Mod 19)) - 21) Mod 30) + 21
OsterSonntag = DateSerial(Jahr, 3, 1) + d + (d > 48) + 6 - ((Jahr + Jahr \ 4 + d + (d > 48) + 1) Mod 7)
End Function
[NachObenLetzte Verweis=„CS: Werk- und Arbeitstage”]