Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1108to1112
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

per VBA 10Nettoarbeitstage zu einem Datum addieren

per VBA 10Nettoarbeitstage zu einem Datum addieren
Mike
Hallo,
wie kann man zu einem Datum 10 Nettoarbeitstage per VBA addieren?
In meinem Beispiel erhalte ich den 11.09.2009, ich benötige jedoch den 15.09.2009!
Sub test() Dim x As Date x = NeuesDatum("01.09.2009", 10) MsgBox x End Sub
Function NeuesDatum(dDatum As Date, iNettotage As Integer) As Date
NeuesDatum = DateAdd("d", iNettotage, dDatum)
End Function

Vielen Dank!
Mike

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
Beispiel
08.10.2009 14:53:55
Backowe
Hi Mike,
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 IntegerAs 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
AW: Beispiel
Petra

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
Beispiel
Backowe

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 BooleanOptional 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 IntegerAs 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
Beispiel
Backowe

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 
 ABC
1Di, 29.12.20095Do, 07.01.2010

Formeln der Tabelle
ZelleFormel
C1=ersatzarbeitstag(A1;B1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Jürgen
AW: vielen DANK oT
Petra

AW: Beispiel
Mike

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
AW: Beispiel
robert

hi,
meinst du so ?
gruß
robert
https://www.herber.de/bbs/user/64966.xls
Beispiel
Backowe

Hi Mike,
hier mal zur Verdeutlichung:
 ABC
1Mo, 05.10.200910Mo, 19.10.2009

Formeln der Tabelle
ZelleFormel
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
Anzeige
AW: Beispiel
08.10.2009 15:13:56
Petra
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
Beispiel
08.10.2009 15:24:05
Backowe
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 BooleanOptional 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 IntegerAs 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
Beispiel
Backowe

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 
 ABC
1Di, 29.12.20095Do, 07.01.2010

Formeln der Tabelle
ZelleFormel
C1=ersatzarbeitstag(A1;B1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Jürgen
AW: vielen DANK oT
Petra

AW: Beispiel
Mike

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
AW: Beispiel
robert

hi,
meinst du so ?
gruß
robert
https://www.herber.de/bbs/user/64966.xls
Beispiel
Backowe

Hi Mike,
hier mal zur Verdeutlichung:
 ABC
1Mo, 05.10.200910Mo, 19.10.2009

Formeln der Tabelle
ZelleFormel
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
Anzeige
Beispiel
08.10.2009 15:31:01
Backowe
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 
 ABC
1Di, 29.12.20095Do, 07.01.2010

Formeln der Tabelle
ZelleFormel
C1=ersatzarbeitstag(A1;B1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Jürgen
Anzeige
AW: vielen DANK oT
08.10.2009 16:25:42
Petra
AW: Beispiel
08.10.2009 15:16:32
Mike
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
Beispiel
08.10.2009 15:26:35
Backowe
Hi Mike,
hier mal zur Verdeutlichung:
 ABC
1Mo, 05.10.200910Mo, 19.10.2009

Formeln der Tabelle
ZelleFormel
C1=ersatzarbeitstag(A1;B1)


Excel Tabellen im Web darstellen >> Excel Jeanie HTML 4
Gruß Jürgen
Anzeige
AW: per VBA 10Nettoarbeitstage zu einem Datum addieren
08.10.2009 16:03:21
Mike
Hi Mr.Backowe :-)
Danke, perfekt!!!
Ciao, Mike

143 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige