Office: [Access 2007] Feiertagsberechnung

Hallo.

Ich bastele gerade eine Sollstundenberechnung für meine Mitarbeiter
und berücksichtige dabei die Sollstd/Tag für jeden einzelnen MA.
Somit habe ich in der Tabelle "Mitarbeiter", die die Stammdaten enthält, zusätzlich die Felder "SollstdMo" bis "SollstdSo" eingerichtet und gefüllt.
Da Abwesenheitszeiten wie Urlaub, Krankheit usw. über Zeiträume (Datumvon und Datumbis) in die Tabelle "Abwesenheit" geschrieben werden, müssen die zu leistenden Stunden während der Abwesenheit von den Sollstunden für den Monat abgezogen werden. Genauso muss ich auch die Anzahl der Abwesenheitstage berechnen, um einen Saldovortrag für den Urlaub zu ermöglichen.

Ich habe vier Funktionen, die dies auch einwandfrei bewerkstelligen. Nur habe ich nun das Problem, dass Feiertage noch nicht berücksichtigt werden. Ich habe eine Tabelle "Feiertage" angelegt, dessen Feld "Feiertag" über ein Formular gefüllt wird. Nun müsste ich in den bereits vorhandenen Funktionen noch zusätzlich abprüfen, ob es sich bei dem aktuellen Tag um einen Feiertag handelt.

Hier sind mal meine Funktionen :

Zunächst die beiden zur Berechnung der Abwesenheitstage...

Code:

Public Function IstArbeitstag(datDatum As Date, strMAID As String) As Boolean
Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("select * from Mitarbeiter where Personalnummer='" & strMAID & "'", dbOpenSnapshot)
        IstArbeitstag = False
Select Case Weekday(datDatum)
  Case 1
  IstArbeitstag = Nz(rst!SollstdSo, 0)
  Case 2
  IstArbeitstag = Nz(rst!SollstdMo, 0)
  Case 3
  IstArbeitstag = Nz(rst!SollstdDi, 0)
  Case 4
  IstArbeitstag = Nz(rst!SollstdMi, 0)
  Case 5
  IstArbeitstag = Nz(rst!SollstdDo, 0)
  Case 6
  IstArbeitstag = Nz(rst!SollstdFr, 0)
  Case 7
  IstArbeitstag = Nz(rst!SollstdSa, 0)
  Case Else
IstArbeitstag = False
End Select
rst.Close
Set rst = Nothing
End Function

Schleifenfunktion zur Berechnung der Abwesenheitstage :

Code:

Public Function AnzArbTageMA(VMDatumvon As Date, VMDatumbis As Date, strMAID As String) As Long
Dim aktTag As Date

For aktTag = VMDatumvon To VMDatumbis
    If IstArbeitstag(aktTag, strMAID) Then
    AnzArbTageMA = AnzArbTageMA + 1
    End If
Next
End Function

Funktioniert bis auf die Berücksichtigung der Feiertage einwandfrei.


Hier die Funktionen zur Berechnung der Abwesenheitsstunden :

Code:

Public Function MASollStunden(datDatum As Date, strMAID As String) As Double
Dim rst As DAO.Recordset
    Set rst = CurrentDb.OpenRecordset("select * from Mitarbeiter where Personalnummer='" & strMAID & "'", dbOpenSnapshot)
Select Case Weekday(datDatum)
Case 1
MASollStunden = Nz(rst!SollstdSo, 0)
Case 2
MASollStunden = Nz(rst!SollstdMo, 0)
Case 3
MASollStunden = Nz(rst!SollstdDi, 0)
Case 4
MASollStunden = Nz(rst!SollstdMi, 0)
Case 5
MASollStunden = Nz(rst!SollstdDo, 0)
Case 6
MASollStunden = Nz(rst!SollstdFr, 0)
Case 7
MASollStunden = Nz(rst!SollstdSa, 0)
Case Else
MASollStunden = 0
End Select
rst.Close
Set rst = Nothing
End Function

Schleifenfunktion zur Berechnung der Abwesenheitsstunden :

Code:

Public Function AnzArbStdMA(VMDatumvon As Date, VMDatumbis As Date, strMAID As String) As Double
Dim aktTag As Date
For aktTag = VMDatumvon To VMDatumbis
 AnzArbStdMA = AnzArbStdMA + MASollStunden(aktTag, strMAID)
Next
End Function

Funktioniert ebenfalls bis auf die Berücksichtigung der Feiertage einwandfrei.

Nun sollen die Funktionen aber noch die Tabelle "Feiertage" daraufhin prüfen, ob es sich bei dem aktTag um einen Feiertag handelt.

Hat jemand eine Idee, wie ich dies mit einbauen kann ?

Hoffe auf Eure Mithilfe !

Gruß
Karsten

 

Hi Karsten,

schau hier - dort findest Du eine Funktion:

Feiertage eines Jahres ermitteln

 

@Freaky

Da hast Du etwas falsch verstanden.
Die Feiertage stehen schon fest. Sie werden in eine Tabelle Feiertage eingepflegt. Nun soll der Abwesenheitszeitraum Tag für Tag mit der Tabelle Feiertage verglichen werden, ob es sich bei dem Abwesenheitstag um einen Feiertag handelt.
Trotzdem Danke.

Gruß
Karsten

 

Hi,

und wie sieht die Tabelle aus? Wie sidn die Inhalte aufgebaut?

 

@Freaky.

Die Tabelle heißt "Feiertage" und die Felder "ID" und "Feiertag". Feiertag ist als TT.MM.JJJJ eingetragen.

Gruß
Karsten

 

Hi,

das sit aber eher schlecht - denn jedes Jahr kommt ja wieder was dazu... denn die Feiertage liegen ja ggf. jedes Jahr auf einen anderen Wochentag.

Da würde ich Dir die Funktion empfehlen.

Und dann das Datum abfragen, dass Du ja dort auch hast.

Hier mal die Funktion etwas anders:

Code:

Option Explicit
'// ----------------------------------------------------------------
'// Feiertagsberechnung nach dem Algorithmus von Carl Friedrich Gauß
'// ----------------------------------------------------------------
Type DtFeiertage
     Jahreszahl         As Long
     Ostern             As Date
     Neujahr            As Date
     DreiKoenige        As Date
     Rosenmontag        As Date
     Aschermittwoch     As Date
     Karfreitag         As Date
     Ostersonntag       As Date
     Ostermontag        As Date
     Maifeiertag        As Date
     ChrHimmelfahrt     As Date
     Pfingstsonntag     As Date
     Pfingstmontag      As Date
     Fronleichnam       As Date
     MariaeHimmelfahrt  As Date
     DtEinheit          As Date
     Reformationstag    As Date
     Allerheiligen      As Date
     Heiligabend        As Date
     Weihnachten1       As Date
     Weihnachten2       As Date
     Sylvester          As Date
End Type
 
Dim m_uDTF As DtFeiertage
 
 
Public Function Feiertag(mdatum As Date) As Boolean
 
   Dim Jahreszahl As Integer
   Dim mbol As Boolean
   
   Jahreszahl = DatePart("yyyy", mdatum)
    
   mbol = False

'// Als Refrenzdatum zunächst m_uDTF.Ostern berechnen
    If Not Ostern_berechnen(Jahreszahl) Then Exit Function
    
'// Neujahr setzen (fester Feiertag am 1. Januar)
    m_uDTF.Neujahr = DateSerial(Jahreszahl, 1, 1)
    If mdatum = m_uDTF.Neujahr Then mbol = True
   
'// Hl. Drei Könige setzen (fester Feiertag am 6. Januar)
    m_uDTF.DreiKoenige = DateSerial(Jahreszahl, 1, 6)
    If mdatum = m_uDTF.DreiKoenige Then mbol = True
 
'// Rosenmontag berechnen (beweglicher Feiertag; 48 Tage vor Ostern)
    m_uDTF.Rosenmontag = m_uDTF.Ostern - 48
    If mdatum = m_uDTF.Rosenmontag Then mbol = True
 
'// Aschemittwoch berechnen (beweglicher Feiertag; 46 Tage vor Ostern)
    m_uDTF.Aschermittwoch = m_uDTF.Ostern - 46
    If mdatum = m_uDTF.Aschermittwoch Then mbol = True
 
'// Karfreitag berechnen (beweglicher Feiertag; 2 Tage vor Ostern)
    m_uDTF.Karfreitag = m_uDTF.Ostern - 2
    If mdatum = m_uDTF.Karfreitag Then mbol = True
 
'// Ostersonntag = m_uDTF.Ostern!
    m_uDTF.Ostersonntag = m_uDTF.Ostern
    If mdatum = m_uDTF.Ostersonntag Then mbol = True
 
'// Ostermontag berechnen (beweglicher Feiertag; 1 Tag nach Ostern)
    m_uDTF.Ostermontag = m_uDTF.Ostern + 1
    If mdatum = m_uDTF.Ostermontag Then mbol = True
 
'// Maifeiertag setzen (fester Feiertag am 1. Mai)
    m_uDTF.Maifeiertag = DateSerial(Jahreszahl, 5, 1)
    If mdatum = m_uDTF.Maifeiertag Then mbol = True
 
'// Christi Himmelfahrt berechnen (beweglicher Feiertag; 39 Tage nach Ostern)
    m_uDTF.ChrHimmelfahrt = m_uDTF.Ostern + 39
    If mdatum = m_uDTF.ChrHimmelfahrt Then mbol = True
 
'// Pfingstsonntag berechnen (beweglicher Feiertag; 49 Tage nach Ostern)
    m_uDTF.Pfingstsonntag = m_uDTF.Ostern + 49
    If mdatum = m_uDTF.Pfingstsonntag Then mbol = True
 
'// Pfingstmontag berechnen (beweglicher Feiertag; 50 Tage nach Ostern)
    m_uDTF.Pfingstmontag = m_uDTF.Ostern + 50
    If mdatum = m_uDTF.Pfingstmontag Then mbol = True
 
'// Fronleichnam berechnen (beweglicher Feiertag; 60 Tage nach Ostern)
    m_uDTF.Fronleichnam = m_uDTF.Ostern + 60
    If mdatum = m_uDTF.Fronleichnam Then mbol = True
 
'// Mariä Himmelfahrt setzen (fester Feiertag am 15. August)
    m_uDTF.MariaeHimmelfahrt = DateSerial(Jahreszahl, 8, 15)
    If mdatum = m_uDTF.MariaeHimmelfahrt Then mbol = True
 
'// Tag der deutschen Einheit setzen (fester Feiertag am 3. Oktober)
    m_uDTF.DtEinheit = DateSerial(Jahreszahl, 10, 3)
    If mdatum = m_uDTF.DtEinheit Then mbol = True
 
'// Reformationstag setzen (fester Feiertag am 31. Oktober)
    m_uDTF.Reformationstag = DateSerial(Jahreszahl, 10, 31)
    If mdatum = m_uDTF.Reformationstag Then mbol = True
 
'// Allerheiligen setzen (fester Feiertag am 1. November)
    m_uDTF.Allerheiligen = DateSerial(Jahreszahl, 11, 1)
    If mdatum = m_uDTF.Allerheiligen Then mbol = True
 
'// Heiligabend setzen (fester 'Feiertag' am 24. Dezember)
    m_uDTF.Heiligabend = DateSerial(Jahreszahl, 12, 24)
    If mdatum = m_uDTF.Heiligabend Then mbol = True
 
'// Erster Weihnachtstag setzen (fester 'Feiertag' am 25. Dezember)
    m_uDTF.Weihnachten1 = DateSerial(Jahreszahl, 12, 25)
    If mdatum = m_uDTF.Weihnachten1 Then mbol = True
 
'// Zweiter Weihnachtstag setzen (fester 'Feiertag' am 26. Dezember)
    m_uDTF.Weihnachten2 = DateSerial(Jahreszahl, 12, 26)
    If mdatum = m_uDTF.Weihnachten2 Then mbol = True
 
'// Sylvester setzen (fester 'Feiertag' am 31. Dezember)
    m_uDTF.Sylvester = DateSerial(Jahreszahl, 12, 31)
    If mdatum = m_uDTF.Sylvester Then mbol = True
 
   Feiertag = mbol
 
End Function
 
Function Ostern_berechnen(ByVal lYear As Long) As Boolean
 
'// Berechnung mit Hilfe des Algorithmus von Gauß
    On Error GoTo Err_Ostern_berechnen
 
    Dim i1  As Integer
    Dim i2  As Integer
    Dim i3  As Integer
    Dim i4  As Integer
    Dim i5  As Integer
    Dim iTZ As Integer                            '// iTZ = Tageszahl
 
    i1 = lYear Mod 19                             '// Formel nach Gauß
    i2 = lYear Mod 4                              '// Werte für die Jahre
    i3 = lYear Mod 7                              '// 1900 - 2099
 
    i4 = (19 * i1 + 24) Mod 30
    i5 = (2 * i2 + 4 * i3 + 6 * i4 + 5) Mod 7
    iTZ = 22 + i4 + i5                            '// Ermittelt den Tag
    If iTZ > 31 Then                              '// März oder April
        iTZ = iTZ - 31                            '// Wenn April, dann - 31 Tage
        If iTZ = 26 Then iTZ = 19                 '// Wenn 26.4. dann 19.4.
        If (iTZ = 25 And i4 = 28 And i1 > 10) Then iTZ = 18
        m_uDTF.Ostern = DateSerial(lYear, 4, iTZ) '// Ostern im April
    Else
        m_uDTF.Ostern = DateSerial(lYear, 3, iTZ) '// Ostern im Maerz
    End If
    Ostern_berechnen = True
 
Exit_Ostern_berechnen:
    Exit Function
 
Err_Ostern_berechnen:
    Ostern_berechnen = False
    GoTo Exit_Ostern_berechnen
 
End Function

Das alles in ein Modul.

Nun kannst Du den Feiertag nach Deinem Datum abfragen:

Code:

   If Feiertag(datDatum) Then
      MsgBox "Ist ein Feiertag!"
   End If

Das musst Du dann an den Stellen in Deine anderen Funktionen nur einbauen...

 

Hi nochmal,

weil ich gerade Deinen Code in Codetags gesetzt habe - hier z.B: mal in die Funktion "IstArbeitstag" eingebaut:

Code:

Public Function IstArbeitstag(datDatum As Date, strMAID As String) As Boolean
   Dim rst As DAO.Recordset
   Set rst = CurrentDb.OpenRecordset("select * from Mitarbeiter where Personalnummer='" & strMAID & "'", dbOpenSnapshot)
   IstArbeitstag = False
   
   If Not Feiertag(datDatum) Then
      Select Case Weekday(datDatum)
        Case 1
         IstArbeitstag = Nz(rst!SollstdSo, 0)
        Case 2
         IstArbeitstag = Nz(rst!SollstdMo, 0)
        Case 3
         IstArbeitstag = Nz(rst!SollstdDi, 0)
        Case 4
         IstArbeitstag = Nz(rst!SollstdMi, 0)
        Case 5
         IstArbeitstag = Nz(rst!SollstdDo, 0)
        Case 6
         IstArbeitstag = Nz(rst!SollstdFr, 0)
        Case 7
         IstArbeitstag = Nz(rst!SollstdSa, 0)
        Case Else
         IstArbeitstag = False
      End Select
   Else
      IstArbeitstag = False
   End If
   
   rst.Close
   Set rst = Nothing
End Function

So siehst Du, wie man es machen könnte...

 

@freaky

Danke, Danke und noch 1000 Mal Danke !!!
Du hast mir das Wochenende gerettet.
Sende mir mal Deine Adresse.
Dann schicke ich Dir mal ne leckere Flasche Wein rüber.

Gruß
Karsten

 

Hi,

...Dein Dank reicht mir erstmal aus .... :-D

Trink ein Schluck auf mein Wohl!

 

@freaky

OK. Ich trinke mal einen für Dich mit.

Grüße aus dem Sauerland

Karsten

 

Hallo freaky,

Du schreibst, Deine Funktion zur Osterfestberechnung (nach Gauß) ist gültig für die Jahre 1900-2099.
Falls es Dich interessiert, folgende weitaus kürzere Funktion ist gültig für die Jahre 1894-2203:

Code:

Function Easter(Jahr As Long) As Date
  Easter = Round(DateValue(Day(Minute(Jahr / 38) / 2 + 1516) & ".4." & Jahr) / 7 - (Jahr = 2079), 0) * 7 - 6
End Function

Folgende Funktion ist gültig ab dem Jahr 1583 (1. mögliches Jahr) bis zur nächsten Kalenderreform:

Code:

'JH  Jahrhundert
'GZ  Goldene Zahl
'Tg  Tage vom 21.3. bis Ostervollmond (14.Nisan):=(23-GregEpakte)mod 30
'VM  Vollmonddatum (14.Nisan): Palmsonntag..Karsamstag
'
Function Easter(Jahr As Long) As Date
  Dim GZ As Long, JH As Long, Tg As Long, VM As Date
  JH = Jahr \ 100 + 1 
  GZ = Jahr Mod 19 + 1  
  Tg = (19 * GZ + (3 * JH) \ 4 - (8 * JH + 5) \ 25  - 4) Mod 30
  If (Tg = 28 And GZ > 11) Or (Tg = 29) Then Tg = Tg - 1  
  VM = DateSerial((Jahr), 3, 21) + Tg  
  Easter = VM - Weekday(VM) + 8                               
End Function

 

Hi Exl121150,

....wer berechnen will, ob 2199 am 3.10. ein Feiertag ist - bestimmt wichtig. Aber ich denke nicht unbedingt hier praxisbezogen.

Wahrscheinlich ist es auch nicht wichtig, ob 1756 an diesem Tag ein Feiertag war .... denn wir will schon da noch Arbeitstage berechnen... :-D

Trotzdem Danke für den ergänzenden Code - vielleicht braucht jemand es für was anderes.

Ach ja: der Code ist aus dem Link und von mir nur hier als Funktion angepasst. Ich legeWert darauf, das sich nicht der Urheber des Codes bin. Der steht in dem Link oben!
Sowas ist heutzutage ja nicht unwichtig. :-)