Nettoarbeitstage in VBA

Hallo Excel-Freunde
ich habe schon seit langem folgenden Code (Quelle unbekannt)
der mir zwischen 2 Datumsangaben die Nettoarbeitstage berechnet.
Der funktioniert auch wunderbar - nur leider macht er einen kleinen Fehler
Ist das Start-Datum = End-Datum, berechnet er mir immer den Wert 0
(und nicht 1, wenn der Tag ein normaler Arbeitstag ist)
Wir nutzen diese Formeln, da unser Admin das entspr Analyse-AddIn gesperrt hat.
Hat jemand einen Tip, diesen "Mini-Fehler" zu korrigieren ?
Besten Gruss
Werner
hier der Code:
Option Explicit

Public Function ArbTag(Datum As Range, Optional ArbeitsTage As Range, Optional FreieTage As  _
Range)
'Auflistung Arbeitstage mit Berücksichtigung der Feiertage + optional zusätzliche ArbeitsTage
'und / oder zusätzliche freie Tage!
Dim i%
Application.Volatile
If IsDate(Datum) Then
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
For i = 1 To 5
If ATag(Datum + i) = 1 Then
Exit For
End If
Next
ElseIf ArbeitsTage Is Nothing Then
For i = 1 To 1000
If ATag(Datum + i) = 1 And Application.IsNumber(Application.Match(CLng(Datum + i),  _
FreieTage, 0)) = False Then
Exit For
End If
Next
ElseIf FreieTage Is Nothing Then
For i = 1 To 1000
If ATag(Datum + i) Or Application.IsNumber(Application.Match(CLng(Datum + i), ArbeitsTage, _
0)) Then
Exit For
End If
Next
Else
For i = 1 To 1000
If ATag(Datum + i) And Application.IsNumber(Application.Match(CLng(Datum + i), FreieTage,  _
0)) = False _
Or Application.IsNumber(Application.Match(CLng(Datum + i), ArbeitsTage, 0)) Then
Exit For
End If
Next
End If
End If
ArbTag = Datum + i
End Function

Public Function NettoArbTage(Beginn As Date, Ende As Date, Optional ArbeitsTage As Range,  _
Optional FreieTage As Range)
'Berechnung NettoArbeitstage mit Berücksichtigung der Feiertage + optional zusätzliche  _
ArbeitsTage
'und / oder zusätzliche freie Tage!
Application.Volatile
If IsDate(Beginn) And IsDate(Ende) And Beginn

Public Function ATag(Datum As Date) As Integer
'!!! Achtung :   Feiertage, bitte anpassen !!!
Dim Feiertage(13) As Date
Dim Jahr%, WTag%, i&
Jahr = CInt(Format(Datum, "yyyy"))
WTag = CInt(Weekday(Datum, 2))
ATag = 1
If WTag > 5 Then
ATag = 0
Else
' Feiertage
' Karfreitag
Feiertage(0) = (Ostersonntag(Jahr)) - 2
' Ostermontag
Feiertage(1) = (Ostersonntag(Jahr)) + 1
' Christi Himmelfahrt
Feiertage(2) = (Ostersonntag(Jahr)) + 39
' Pfingstmontag
Feiertage(3) = (Ostersonntag(Jahr)) + 50
' Fronleichnam
Feiertage(4) = (Ostersonntag(Jahr)) + 60
' Neujahr
Feiertage(5) = CDate("01.01." & Jahr)
' 1.Mai
Feiertage(6) = CDate("01.05." & Jahr)
' Maria Himmelfahrt > kein Feiertag
'Feiertage(7) = CDate("15.08." & Jahr)
' Tag der deutschen Einheit
If Jahr  kein Feiertag
'Feiertage(9) = CDate("01.11." & Jahr)
' Weihnachtstag
Feiertage(10) = CDate("24.12." & Jahr)
' 1. Weihnachtstag
Feiertage(11) = CDate("25.12." & Jahr)
' 2.Weihnachtstag
Feiertage(12) = CDate("26.12." & Jahr)
' Sylvester
Feiertage(13) = CDate("31.12." & Jahr)
' Ist das Datum ein Feiertag?
For i = 0 To 13
If Datum = Feiertage(i) Then
ATag = 0
Exit For
End If
Next i
End If
End Function

Function Ostersonntag(Jahr As Integer) As Date
Dim intA As Integer, intB As Integer, intC As Integer, intD As Integer
Dim intE As Integer, intF As Integer, intG As Integer, intH As Integer
Dim intI As Integer, intK As Integer, intL As Integer, intM As Integer
Dim intN As Integer, intP As Integer
Application.Volatile
Select Case Jahr
Case Is >= 1900
intA = Jahr Mod 19
intB = Int(Jahr / 100)
intC = Jahr Mod 100
intD = Int(intB / 4)
intE = intB Mod 4
intF = Int((intB + 8) / 25)
intG = Int((intB - intF + 1) / 3)
intH = (19 * intA + intB - intD - intG + 15) Mod 30
intI = Int(intC / 4)
intK = intC Mod 4
intL = (32 + 2 * intE + 2 * intI - intH - intK) Mod 7
intM = Int((intA + 11 * intH + 22 * intL) / 451)
intN = Int((intH + intL - 7 * intM + 114) / 31)
intP = (intH + intL - 7 * intM + 114) Mod 31
Ostersonntag = DateSerial(Jahr, intN, intP + 1)
End Select
End Function

Hallo,
rein für Nettoarbeitstage habe ich was kürzeres.
Zusätzliche AT haben Vorrang vor Feiertagen und Wochenenden.

Function NettoArbTage(dteStart As Date, _
dteEnde As Date, _
Optional rngZusatz As Range, _
Optional rngFrei As Range)
Dim xDatum As Date, bolFrei As Boolean, bolZusatz As Boolean
For xDatum = dteStart To dteEnde
If Not rngFrei Is Nothing Then
bolFrei = WorksheetFunction.CountIf(rngFrei, xDatum) > 0
bolFrei = bolFrei Or istFeiertag(xDatum)
Else
bolFrei = istFeiertag(xDatum)
End If
If Not rngZusatz Is Nothing Then
bolZusatz = WorksheetFunction.CountIf(rngZusatz, xDatum)  0
Else
bolZusatz = False
End If
If bolZusatz Then
NettoArbTage = NettoArbTage + 1
Else
If Not bolFrei Then
If xDatum Mod 7 > 1 Then
NettoArbTage = NettoArbTage + 1
End If
End If
End If
Next
End Function
Function istFeiertag(datum) As Boolean
Dim d As Integer, iJahr As Integer, OSo As Date
iJahr = Year(datum)
d = (((255 - 11 * (iJahr Mod 19)) - 21) Mod 30) + 21
OSo = DateSerial(iJahr, 3, 1) + d + (d > 48) + 6 _
- ((iJahr + iJahr \ 4 + d + (d > 48) + 1) Mod 7)
Select Case datum
Case OSo - 2, _
OSo + 1, _
OSo + 39, _
OSo + 50, _
OSo + 60, _
DateSerial(iJahr, 1, 1), _
DateSerial(iJahr, 5, 1), _
DateSerial(iJahr, 10, 3), _
DateSerial(iJahr, 11, 1), _
DateSerial(iJahr, 12, 25), _
DateSerial(iJahr, 12, 26)
istFeiertag = True
End Select
'Karfreitag=Ostersonntag-2
'Ostermontag=Ostersonntag+1
'Chr.Himmelfahrt=Ostersonntag+39
'Pfingstmontag=Ostersonntag+50
'Fronleichnam=Ostersonntag+60
End Function

Gruß
Rudi

Forumthread: Nettoarbeitstage in VBA

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Infobox / Tutorial