Function myPrivateNetworkDays(myStart As Range, myEnd As Range, Optional freedays As Range) As Long
'by Ramses
'Aufruf erfolgt in Tabelle
'=myPrivateNetworkDays(A1;A2;B1:B10)
'A1 = StartDatum
'A2 = EndDatum
'B1:B10 = Bereich in dem die freien Tage als Datum definiert sind
On Error GoTo myErrorHandler
Dim i As Long, n As Long, DayChk As Boolean
Dim myNetDays As Long, myF As Variant
Dim myC As Range
myNetDays = 0
n = 0
DayChk = False
For i = myStart To myEnd
If Weekday(Format(myStart + n, "dd.mm.yyyy"), vbMonday) < 6 Then
'On Error Resume Next
For Each myC In freedays
If myC.Value = myStart + n Then
DayChk = True
Exit For
End If
Next
Weiter:
Err.Clear
If DayChk = False Then
myNetDays = myNetDays + 1
End If
DayChk = False
End If
n = n + 1
Next i
ErrExit:
myPrivateNetworkDays = myNetDays
Exit Function
myErrorHandler:
Select Case Err.Number
Case 424 'Kein Feiertagsbereich
Resume Weiter
Case Else
MsgBox Err.Number & ": " & Err.Description
Resume ErrExit
End Select
End Function
Function EasterDate(Yr As Integer) As Date
Dim d As Integer
d = (((255 - 11 * (Yr Mod 19)) - 21) Mod 30) + 21
EasterDate = DateSerial(Yr, 3, 1) + d + (d > 48) + 6 - ((Yr + Yr \ 4 + d + (d > 48) + 1) Mod 7)
End Function