Nur Werk- bzw. Arbeitstage

Für einen definierten Zeitraum: Nur Werk- bzw. Arbeitstage

Per Makro/VBA sollen für einen definierten Zeitraum alle Werk- oder Arbeit­stage einge­tra­gen wer­den. Unsere Def­i­n­i­tion: „Werk­tage” ist immer Mon­tag bis Fre­itag, also auch der Kar­fre­itag oder Pfin­gst­mon­tag. Und natür­lich auch die Wei­h­nacht­stage, sofern sie nicht am Woch­enende sind. „Arbeit­stage” sind grund­sät­zlich alle Werk­tage aber ohne die Feiertage. 

Mit­tels der bei­den fol­gen­den Proze­duren wird im aktuellen Arbeits­blatt entwed­er senkrecht (Stan­dard) oder waagerecht der entsprechende Datums­bere­ich aus­ge­füllt. Die Start-Zelle sowie  das For­mat des Datums kön­nen im Code leicht angepasst wer­den.

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
[NachOben­Let­zte Verweis=„CS: Werk- und Arbeit­stage”]
Dieser Beitrag wurde unter Code-Schnipsel, Datum und Zeit, Mit VBA/Makro, Verschiedenes abgelegt und mit , , , , , verschlagwortet. Setze ein Lesezeichen auf den Permalink.