Option Explicit
Sub test()
Dim x As Date
x = ErsatzArbeitstag("01.09.2009", 10)
MsgBox x
End Sub
Public Function ErsatzArbeitstag(Beginn As Date, AnzahlTage&, Optional ArbeitsTage As Range, Optional FreieTage As Range)
'Berechnung Arbeitstag +/- Anzahl Tage mit Berücksichtigung der Feiertage + optional zusätzliche ArbeitsTage
'und / oder zusätzliche freie Tage!
Application.Volatile
If IsDate(Beginn) And IsNumeric(AnzahlTage) Then
If AnzahlTage > 0 Then
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
ElseIf ArbeitsTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn + 1), FreieTage, 0)) = False Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
ElseIf FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 Or Application.IsNumber(Application.Match(CLng(Beginn + 1), ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
Else
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn + 1), FreieTage, 0)) = False _
Or Application.IsNumber(Application.Match(CLng(Beginn) + 1, ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
End If
Else
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 Then
AnzahlTage = AnzahlTage + 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
ElseIf ArbeitsTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn - 1), FreieTage, 0)) = False Then
AnzahlTage = AnzahlTage + 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
ElseIf FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 Or Application.IsNumber(Application.Match(CLng(Beginn - 1), ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
Else
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn - 1), FreieTage, 0)) = False _
Or Application.IsNumber(Application.Match(CLng(Beginn) - 1, ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage + 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
End If
End If
End If
ErsatzArbeitstag = Beginn
End Function
Public Function ATag(Datum As Date) As Integer
'!!! Achtung saarländische Feiertage, bitte anpassen !!!
Dim Feiertage(12) As Date
Dim Jahr%, WTag%, i%
Jahr = CInt(Format(Datum, "yyyy"))
WTag = CInt(Weekday(Datum, 2))
ATag = 1
If WTag > 5 Then
ATag = 0 ' Wochenende
Else
Feiertage(0) = (Ostersonntag(Jahr)) - 2 ' Karfreitag
Feiertage(1) = (Ostersonntag(Jahr)) + 1 ' Ostermontag
Feiertage(2) = (Ostersonntag(Jahr)) + 39 ' Christi Himmelfahrt
Feiertage(3) = (Ostersonntag(Jahr)) + 50 ' Pfingstmontag
Feiertage(4) = (Ostersonntag(Jahr)) + 60 ' Fronleichnam
Feiertage(5) = CDate("01.01." & Jahr) ' Neujahr
Feiertage(6) = CDate("01.05." & Jahr) ' 1.Mai
Feiertage(7) = CDate("15.08." & Jahr) ' Maria Himmelfahrt
If Jahr < 1990 Then
Feiertage(8) = CDate("17.06." & Jahr) ' Tag der deutschen Einheit
Else
Feiertage(8) = CDate("03.10." & Jahr)
End If
Feiertage(9) = CDate("01.11." & Jahr) ' Allerheiligen
Feiertage(10) = CDate("25.12." & Jahr) ' 1. Weihnachtstag
Feiertage(11) = CDate("26.12." & Jahr) ' 2.Weihnachtstag
' Ist das Datum ein Feiertag?
For i = 0 To 11
If Datum = Feiertage(i) Then
ATag = 0
Exit For
End If
Next i
End If
End Function
Public 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
Gruß Jürgen
Hallo Backowe
hab mir Dein Beispiel angeschaut, weil ich auch so was ähnliches brauche,
ganz prima Deine Lösung! Nur funzt es bei meinem Beispiel nicht:
29.12.2009 plus 5 AT ergibt bei Dir 6.1.2010. Der 6.Jan. ist aber hier Feiertag. Hab ihn auch in Deiner Funktion eingebaut.
Wie muß das Ganze umgebaut werden, das dies auch jahresübergreifend funzt?
Liebe Grüße
Petra
Hallo Petra,
das funktioniert auch jahresübergreifend! Die Function ATag ist auf saarländischen Feiertage angepasst und diese muss geändert werden.
Hier noch die anderen Funktionen! :)
Public Function ArbTag(Datum As Range, Optional Rueckwaerts As Boolean, Optional ArbeitsTage As Range, Optional FreieTage As Range)
'Auflistung Arbeitstage vorwärts und rückwärts mit Berücksichtigung der Feiertage + optional zusätzliche ArbeitsTage
'und / oder zusätzliche freie Tage!
Dim i&
Application.Volatile
If IsDate(Datum) Then
If Rueckwaerts = False Then
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
For i = 1 To Rows.Count
If ATag(Datum + i) = 1 Then
Exit For
End If
Next
ElseIf ArbeitsTage Is Nothing Then
For i = 1 To Rows.Count
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 Rows.Count
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 Rows.Count
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
Else
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
For i = 1 To Rows.Count
If ATag(Datum - i) = 1 Then
Exit For
End If
Next
ElseIf ArbeitsTage Is Nothing Then
For i = 1 To Rows.Count
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 Rows.Count
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 Rows.Count
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
End If
If Rueckwaerts = False Then
ArbTag = Datum + i
Else
ArbTag = Datum - i
End If
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 < Ende Then
Do While Beginn <= Ende
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
If ATag(Beginn) = 1 Then
NettoArbTage = NettoArbTage + 1
End If
ElseIf ArbeitsTage Is Nothing Then
If ATag(Beginn) = 1 And Application.IsNumber(Application.Match(CLng(Beginn), FreieTage, 0)) = False Then
NettoArbTage = NettoArbTage + 1
End If
ElseIf FreieTage Is Nothing Then
If ATag(Beginn) = 1 Or Application.IsNumber(Application.Match(CLng(Beginn), ArbeitsTage, 0)) Then
NettoArbTage = NettoArbTage + 1
End If
Else
If ATag(Beginn) = 1 And Application.IsNumber(Application.Match(CLng(Beginn), FreieTage, 0)) = False _
Or Application.IsNumber(Application.Match(CLng(Beginn), ArbeitsTage, 0)) Then
NettoArbTage = NettoArbTage + 1
End If
End If
Beginn = Beginn + 1
Loop
Else
NettoArbTage = 0
End If
End Function
Public Function ErsatzArbeitstag(Beginn As Date, AnzahlTage&, Optional ArbeitsTage As Range, Optional FreieTage As Range)
'Berechnung Arbeitstag +/- Anzahl Tage mit Berücksichtigung der Feiertage + optional zusätzliche ArbeitsTage
'und / oder zusätzliche freie Tage!
Application.Volatile
If IsDate(Beginn) And IsNumeric(AnzahlTage) Then
If AnzahlTage > 0 Then
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
ElseIf ArbeitsTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn + 1), FreieTage, 0)) = False Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
ElseIf FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 Or Application.IsNumber(Application.Match(CLng(Beginn + 1), ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
Else
Do Until AnzahlTage = 0
If ATag(Beginn + 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn + 1), FreieTage, 0)) = False _
Or Application.IsNumber(Application.Match(CLng(Beginn) + 1, ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn + 1
Else
Beginn = Beginn + 1
End If
Loop
End If
Else
If ArbeitsTage Is Nothing And FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 Then
AnzahlTage = AnzahlTage + 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
ElseIf ArbeitsTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn - 1), FreieTage, 0)) = False Then
AnzahlTage = AnzahlTage + 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
ElseIf FreieTage Is Nothing Then
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 Or Application.IsNumber(Application.Match(CLng(Beginn - 1), ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage - 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
Else
Do Until AnzahlTage = 0
If ATag(Beginn - 1) = 1 And Application.IsNumber(Application.Match(CLng(Beginn - 1), FreieTage, 0)) = False _
Or Application.IsNumber(Application.Match(CLng(Beginn) - 1, ArbeitsTage, 0)) Then
AnzahlTage = AnzahlTage + 1
Beginn = Beginn - 1
Else
Beginn = Beginn - 1
End If
Loop
End If
End If
End If
ErsatzArbeitstag = Beginn
End Function
Public Function ATag(Datum As Date) As Integer
'!!! Achtung saarländische Feiertage, bitte anpassen !!!
Dim Feiertage(12) As Date
Dim Jahr%, WTag%, i%
Jahr = CInt(Format(Datum, "yyyy"))
WTag = CInt(Weekday(Datum, 2))
ATag = 1
If WTag > 5 Then
ATag = 0 ' Wochenende
Else
Feiertage(0) = (Ostersonntag(Jahr)) - 2 ' Karfreitag
Feiertage(1) = (Ostersonntag(Jahr)) + 1 ' Ostermontag
Feiertage(2) = (Ostersonntag(Jahr)) + 39 ' Christi Himmelfahrt
Feiertage(3) = (Ostersonntag(Jahr)) + 50 ' Pfingstmontag
Feiertage(4) = (Ostersonntag(Jahr)) + 60 ' Fronleichnam
Feiertage(5) = CDate("01.01." & Jahr) ' Neujahr
Feiertage(6) = CDate("01.05." & Jahr) ' 1.Mai
Feiertage(7) = CDate("15.08." & Jahr) ' Maria Himmelfahrt
If Jahr < 1990 Then
Feiertage(8) = CDate("17.06." & Jahr) ' Tag der deutschen Einheit
Else
Feiertage(8) = CDate("03.10." & Jahr)
End If
Feiertage(9) = CDate("01.11." & Jahr) ' Allerheiligen
Feiertage(10) = CDate("25.12." & Jahr) ' 1. Weihnachtstag
Feiertage(11) = CDate("26.12." & Jahr) ' 2.Weihnachtstag
' Ist das Datum ein Feiertag?
For i = 0 To 11
If Datum = Feiertage(i) Then
ATag = 0
Exit For
End If
Next i
End If
End Function
Public 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
Gruß Jürgen
Hallo Petra,
hier die angepasste Funktion:
Public Function ATag(Datum As Date) As Integer
'!!! Achtung saarländische 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 ' Wochenende
Else
Feiertage(0) = (Ostersonntag(Jahr)) - 2 ' Karfreitag
Feiertage(1) = (Ostersonntag(Jahr)) + 1 ' Ostermontag
Feiertage(2) = (Ostersonntag(Jahr)) + 39 ' Christi Himmelfahrt
Feiertage(3) = (Ostersonntag(Jahr)) + 50 ' Pfingstmontag
Feiertage(4) = (Ostersonntag(Jahr)) + 60 ' Fronleichnam
Feiertage(5) = CDate("01.01." & Jahr) ' Neujahr
Feiertage(6) = CDate("01.05." & Jahr) ' 1.Mai
Feiertage(7) = CDate("15.08." & Jahr) ' Maria Himmelfahrt
If Jahr
| A | B | C | 1 | Di, 29.12.2009 | 5 | Do, 07.01.2010 | Formeln der Tabelle | Zelle | Formel | C1 | =ersatzarbeitstag(A1;B1) |
| Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Jürgen
Hallo Jürgen,
vielen Dank für Deine Mühe! bei Datum 01.10.2009 funktioniert es un es erscheint der 15.10.2009,
doch wenn ich 05.10.2009 eingebe, erhalte ich einen Sonntag den 18.10.2009 und nicht den 19.10.2009!
Gruss, Mike
Hi Mike,
hier mal zur Verdeutlichung:
| A | B | C | 1 | Mo, 05.10.2009 | 10 | Mo, 19.10.2009 | Formeln der Tabelle | Zelle | Formel | C1 | =ersatzarbeitstag(A1;B1) |
| Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Jürgen
AW: per VBA 10Nettoarbeitstage zu einem Datum addieren
Mike
Hi Mr.Backowe :-)
Danke, perfekt!!!
Ciao, Mike
|
|