6
VBA Code Änderung Access 2010
Liebe Gemeinde,
ein Kollege hat mir einmal einen VBA Code zur Ermittlung des 1. und 5. Arbeitstags eines Monats erstellt, nun bräcuhte ich aber den 2. und 6. Arbeitstag eines Monats, ich schaffe es aber nicht den Code dementsprechend zu ändern, bitte um Hilfe:
Der Code besteht aus einer Feiertagsberechnung mit anschließender Werktagsbestimmung(Funktion wird in als Kriterium in die Abfrage in ein Datumsfeld geschrieben), die Funktion "Werktagbestimmung" enthält den besagten Code, unterhalb):
Wie muss der Code aussehen damit der 2. und 6. Arbeitstag bestimmt wird(ACHTUNG, nicht der Werktag, diese Funktion ist auch im Code enthalten!)
Vielen Dank!
Gruß
Dr.
ein Kollege hat mir einmal einen VBA Code zur Ermittlung des 1. und 5. Arbeitstags eines Monats erstellt, nun bräcuhte ich aber den 2. und 6. Arbeitstag eines Monats, ich schaffe es aber nicht den Code dementsprechend zu ändern, bitte um Hilfe:
Der Code besteht aus einer Feiertagsberechnung mit anschließender Werktagsbestimmung(Funktion wird in als Kriterium in die Abfrage in ein Datumsfeld geschrieben), die Funktion "Werktagbestimmung" enthält den besagten Code, unterhalb):
Option Explicit
'// ----------------------------------------------------------------
'// Feiertagsberechnung nach dem Algorithmus von Carl Friedrich Gauß
'// ----------------------------------------------------------------
Type AtFeiertage
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
Nation 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 AtFeiertage
'Dim x As String
Public Function Feiertag(mdatum As Date, FeiertagsName As String) As Integer
Dim Jahreszahl As Integer
Dim mbol As Integer
Jahreszahl = DatePart("yyyy", mdatum)
mbol = 0
'// 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 = 1: FeiertagsName = "Neujahr"
'// Hl. Drei Könige setzen (fester Feiertag am 6. Januar)
m_uDTF.DreiKoenige = DateSerial(Jahreszahl, 1, 6)
If mdatum = m_uDTF.DreiKoenige Then mbol = 1: FeiertagsName = "Hl. Drei Koenige"
'// Rosenmontag berechnen (beweglicher Feiertag; 48 Tage vor Ostern)
'// m_uDTF.Rosenmontag = m_uDTF.Ostern - 48
'// If mdatum = m_uDTF.Rosenmontag Then mbol = True: FeiertagsName = "Rosenmontag"
'// Aschemittwoch berechnen (beweglicher Feiertag; 46 Tage vor Ostern)
'// m_uDTF.Aschermittwoch = m_uDTF.Ostern - 46
'// If mdatum = m_uDTF.Aschermittwoch Then mbol = True: FeiertagsName = "Aschermittwoch"
'// Karfreitag berechnen (beweglicher Feiertag; 2 Tage vor Ostern)
'// m_uDTF.Karfreitag = m_uDTF.Ostern - 2
'// If mdatum = m_uDTF.Karfreitag Then mbol = True: FeiertagsName = "Karfreitag"
'// Ostersonntag = m_uDTF.Ostern!
m_uDTF.Ostersonntag = m_uDTF.Ostern
If mdatum = m_uDTF.Ostersonntag Then mbol = 1: FeiertagsName = "Ostersonntag"
'// Ostermontag berechnen (beweglicher Feiertag; 1 Tag nach Ostern)
m_uDTF.Ostermontag = m_uDTF.Ostern + 1
If mdatum = m_uDTF.Ostermontag Then mbol = 1: FeiertagsName = "Ostermontag"
'// Maifeiertag setzen (fester Feiertag am 1. Mai)
m_uDTF.Maifeiertag = DateSerial(Jahreszahl, 5, 1)
If mdatum = m_uDTF.Maifeiertag Then mbol = 1: FeiertagsName = "Staatsfeiertag"
'// Christi Himmelfahrt berechnen (beweglicher Feiertag; 39 Tage nach Ostern)
m_uDTF.ChrHimmelfahrt = m_uDTF.Ostern + 39
If mdatum = m_uDTF.ChrHimmelfahrt Then mbol = 1: FeiertagsName = "Chr. Himmelfahrt"
'// Pfingstsonntag berechnen (beweglicher Feiertag; 49 Tage nach Ostern)
m_uDTF.Pfingstsonntag = m_uDTF.Ostern + 49
If mdatum = m_uDTF.Pfingstsonntag Then mbol = 1: FeiertagsName = "Pfingstsonntag"
'// Pfingstmontag berechnen (beweglicher Feiertag; 50 Tage nach Ostern)
m_uDTF.Pfingstmontag = m_uDTF.Ostern + 50
If mdatum = m_uDTF.Pfingstmontag Then mbol = 1: FeiertagsName = "Pfingstmontag"
'// Fronleichnam berechnen (beweglicher Feiertag; 60 Tage nach Ostern)
m_uDTF.Fronleichnam = m_uDTF.Ostern + 60
If mdatum = m_uDTF.Fronleichnam Then mbol = 1: FeiertagsName = "Fronleichnam"
'// Mariä Himmelfahrt setzen (fester Feiertag am 15. August)
m_uDTF.MariaeHimmelfahrt = DateSerial(Jahreszahl, 8, 15)
If mdatum = m_uDTF.MariaeHimmelfahrt Then mbol = 1: FeiertagsName = "Maria Himmelfahrt"
'// Nationalfeiertag setzen (fester Feiertag am 26. Oktober)
m_uDTF.Nation = DateSerial(Jahreszahl, 10, 26)
If mdatum = m_uDTF.Nation Then mbol = 1: FeiertagsName = "Nationalfeiertag"
'// Reformationstag setzen (fester Feiertag am 31. Oktober)
'// m_uDTF.Reformationstag = DateSerial(Jahreszahl, 10, 31)
'// If mdatum = m_uDTF.Reformationstag Then mbol = True: FeiertagsTName = "Reformationstag"
'// Allerheiligen setzen (fester Feiertag am 1. November)
m_uDTF.Allerheiligen = DateSerial(Jahreszahl, 11, 1)
If mdatum = m_uDTF.Allerheiligen Then mbol = 1: FeiertagsName = "Allerheiligen"
'// Heiligabend setzen (fester 'Feiertag' am 24. Dezember)
'// m_uDTF.Heiligabend = DateSerial(Jahreszahl, 12, 24)
'// If mdatum = m_uDTF.Heiligabend Then mbol = 1: FeiertagsName = "Heiligabend"
'// Erster Weihnachtstag setzen (fester 'Feiertag' am 25. Dezember)
m_uDTF.Weihnachten1 = DateSerial(Jahreszahl, 12, 25)
If mdatum = m_uDTF.Weihnachten1 Then mbol = 1: FeiertagsName = "Christtag"
'// Zweiter Weihnachtstag setzen (fester 'Feiertag' am 26. Dezember)
m_uDTF.Weihnachten2 = DateSerial(Jahreszahl, 12, 26)
If mdatum = m_uDTF.Weihnachten2 Then mbol = 1: FeiertagsName = "Stefanitag"
'// Sylvester setzen (fester 'Feiertag' am 31. Dezember)
'// m_uDTF.Sylvester = DateSerial(Jahreszahl, 12, 31)
'// If mdatum = m_uDTF.Sylvester Then mbol = True: FeiertagsName = "Silvester"
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
Function Werktagbestimmung(Wahl As Integer, Monat As Integer) As Variant
'Parameter Wahl ' 1 = erster Arbeitstag; 2 = fünfter Arbeitstag; 3 = erster Werktag; 4 = fünfter Werktag
'Parameter Monat ' Übergabe der aktuellen Monatszahl
'Um ersten AT im Monat aufzurufen: Werktagbestimmung(1,Monat(Heute))
Dim wd As Integer
Dim DatumBestimmt As Date
Dim Tageszaehler As Integer
Dim Schleifenzaehler As Integer
Dim DateFound As Boolean
Dim DateCount As Integer
Dim X As Integer
Dim Y As Integer
DateFound = False
DateCount = 0
If Wahl < 3 Then 'Ersten Arbeitstag im Monat ermitteln (Mo bis Fr)
DateFound = False
Do While DateFound = False
DateCount = DateCount + 1
If Feiertag(DateSerial(Year(Now()), Monat, DateCount), "") = False Then
wd = Weekday(DateSerial(Year(Now()), Monat, DateCount), vbMonday)
If wd < 6 Then
DatumBestimmt = DateSerial(Year(Now()), Monat, DateCount)
DateFound = True
End If
End If
Loop
If Wahl = 2 Then 'Fünften Arbeitstag im Monat ermitteln (Mo bis Fr)
DateCount = 0
Tageszaehler = 1
Do While Tageszaehler <> 6
DateCount = DateCount + 1
'If Feiertag(DatumBestimmt + DateCount, "") = False Then
If Feiertag(DateSerial(Year(DatumBestimmt), Month(DatumBestimmt), DateCount), "") = False Then
If Weekday(DateSerial(Year(DatumBestimmt), Month(DatumBestimmt), DateCount), vbMonday) < 6 Then Tageszaehler = Tageszaehler + 1
End If
Loop
DatumBestimmt = DateSerial(Year(DatumBestimmt), Month(DatumBestimmt), DateCount)
End If 'Ende Ermittlung des fünften Arbeitstages (Mo bis Fr)
End If 'Ende Ermittlung des ersten Arbeitstages (Mo bis Fr)
If Wahl > 2 Then 'Ersten Werktag im Monat ermitteln (Mo bis Sa)
DateFound = False
DateCount = 0
Do While DateFound = False
DateCount = DateCount + 1
If Feiertag(DateSerial(Year(Now()), Monat, DateCount), "") = False Then
wd = Weekday(DateSerial(Year(Now()), Monat, DateCount), vbMonday)
If wd < 7 Then
DatumBestimmt = DateSerial(Year(Now()), Monat, DateCount)
DateFound = True
End If
End If
Loop
If Wahl = 4 Then 'Fünften Werktag im Monat ermitteln (Mo bis Sa)
DateCount = 0
Tageszaehler = 1
Do While Tageszaehler <> 6
DateCount = DateCount + 1
If Feiertag(DateSerial(Year(DatumBestimmt), Month(DatumBestimmt), DateCount), "") = False Then
If Weekday(DateSerial(Year(DatumBestimmt), Month(DatumBestimmt), DateCount), vbMonday) < 7 Then Tageszaehler = Tageszaehler + 1
wd = Weekday(DateSerial(Year(DatumBestimmt), Month(DatumBestimmt), DateCount), vbMonday)
X = Y
End If
Loop
DatumBestimmt = DateSerial(Year(DatumBestimmt), Month(DatumBestimmt), DateCount)
End If 'Ende Ermittlung des fünften Werktages (Mo bis Sa)
End If 'Ende Ermittlung des ersten Werktages (Mo bis Sa)
Werktagbestimmung = DatumBestimmt
End FunctionWie muss der Code aussehen damit der 2. und 6. Arbeitstag bestimmt wird(ACHTUNG, nicht der Werktag, diese Funktion ist auch im Code enthalten!)
Vielen Dank!
Gruß
Dr.
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 338215
Url: https://administrator.de/contentid/338215
Ausgedruckt am: 25.11.2024 um 00:11 Uhr
6 Kommentare
Neuester Kommentar
Moin,
auf den ersten Blick würde ich sagen, du brauchst einen zusätzliche IF-Abfrage und while loop (Zeile 200-209) in dem du abprüfst ob "Tageszaehler" <> 3 (für den 2ten) bzw. <>7 (für den 6ten) Arbeitstag.
Schonmal so versucht?
lg,
Slainte
auf den ersten Blick würde ich sagen, du brauchst einen zusätzliche IF-Abfrage und while loop (Zeile 200-209) in dem du abprüfst ob "Tageszaehler" <> 3 (für den 2ten) bzw. <>7 (für den 6ten) Arbeitstag.
Schonmal so versucht?
lg,
Slainte
Mojn,
hab bis jetzt nur beim Code:
+ 1 ergänzt, dann hab ich aber das Problem wenn zb. der 1. Arbeitstag ein Freitag ist(er würde dann als 2. Arbeitstag den Samstag sehen = keine Daten vorhanden).
Ehrlich gesagt blicke ich bei dem Code nicht mehr ganz durch , darum hat ihn mir auch ein Kollegen geschrieben.
Danke!
Gruß
Dr.
hab bis jetzt nur beim Code:
DatumBestimmt = DateSerial(Year(Now()), Monat, DateCount)Ehrlich gesagt blicke ich bei dem Code nicht mehr ganz durch , darum hat ihn mir auch ein Kollegen geschrieben.
Danke!
Gruß
Dr.
Ehrlich gesagt blicke ich bei dem Code nicht mehr ganz durch
Der Codeblock Zeile 200 bis 209 (und die anderen "Baugleichen" iFs mit den loops dahinter) zaehlen die Arbeits bzw. Werktage durch, und wenn die gewünschte Anzahl an Tagen erreicht ist (Zeile 203) dann wird der Loop verlassen und das so bestimmte Datum zurück gegeben..Du kannst auch einfach mal durch die Funktion durchsteppen, dann siehst du genau was passiert.
Moin,
vielen Dank für deine Hilfe, hab mir den Kopf zerbrochen und den Code noch einmal neu geschrieben um ihn besser zu verstehen und ich denke jetzt klappt es mit dem 2. und 6. Arbeitstag.
Was ich noch immer nicht ganz verstehe ich diese Feiertags Funktion, sie zählt also die einzelnen Tage vom Monat durch, ist davon einer ein Feiertag, dann zählt er diesen nicht, aber warum ist dann beim Feiertagsnamen ein "" eingetragen und dann auch noch ein FALSE am Ende?
DAs würde dann doch bedeuten:
Ist der zu prüfende Tag nicht(FALSE) kein("") Feiertag, dann zähle weiter, oder verstehe ich dies falsch.
Wäre toll wenn mir das noch jemand erklären könnte.
Vielen Dank!
Gruß
Dr.
vielen Dank für deine Hilfe, hab mir den Kopf zerbrochen und den Code noch einmal neu geschrieben um ihn besser zu verstehen und ich denke jetzt klappt es mit dem 2. und 6. Arbeitstag.
Function Arbeitstagermittlung(Wahl As Integer, Monat As Integer) As Variant
Dim Datumzahl As Integer
Dim wd As Integer
Dim BestimmtesDatum As Date
Dim Tageszahl As Integer
Datumzahl = 0
If Wahl < 3 Then
Tageszahl = 0
Do While Tageszahl <> 2
Datumzahl = Datumzahl + 1
If Feiertag(DateSerial(Year(Now()), Monat, Datumzahl), "") = False Then
wd = Weekday(DateSerial(Year(Now()), Monat, Datumzahl), vbMonday)
If wd < 6 Then
Tageszahl = Tageszahl + 1
BestimmtesDatum = DateSerial(Year(Now()), Monat, Datumzahl)
End If
End If
Loop
If Wahl = 2 Then
Datumzahl = 0
Tageszahl = 0
Do While Tageszahl <> 6
Datumzahl = Datumzahl + 1
If Feiertag(DateSerial(Year(BestimmtesDatum), Month(BestimmtesDatum), Datumzahl), "") = False Then
If Weekday(DateSerial(Year(BestimmtesDatum), Month(BestimmtesDatum), Datumzahl), vbMonday) < 6 Then
Tageszahl = Tageszahl + 1
BestimmtesDatum = DateSerial(Year(Now()), Monat, Datumzahl)
End If
End If
Loop
End If
End If
Arbeitstagermittlung = BestimmtesDatum
End FunctionWas ich noch immer nicht ganz verstehe ich diese Feiertags Funktion, sie zählt also die einzelnen Tage vom Monat durch, ist davon einer ein Feiertag, dann zählt er diesen nicht, aber warum ist dann beim Feiertagsnamen ein "" eingetragen und dann auch noch ein FALSE am Ende?
If Feiertag(DateSerial(Year(Now()), Monat, DateCount), "") = False Then Ist der zu prüfende Tag nicht(FALSE) kein("") Feiertag, dann zähle weiter, oder verstehe ich dies falsch.
Wäre toll wenn mir das noch jemand erklären könnte.
Vielen Dank!
Gruß
Dr.
Zitat von @Dr.Cornwallis:
Moin,
vielen Dank für deine Hilfe, hab mir den Kopf zerbrochen und den Code noch einmal neu geschrieben um ihn besser zu verstehen und ich denke jetzt klappt es mit dem 2. und 6. Arbeitstag.
Was ich noch immer nicht ganz verstehe ich diese Feiertags Funktion, sie zählt also die einzelnen Tage vom Monat durch, ist davon einer ein Feiertag, dann zählt er diesen nicht, aber warum ist dann beim Feiertagsnamen ein "" eingetragen und dann auch noch ein FALSE am Ende?
DAs würde dann doch bedeuten:
Ist der zu prüfende Tag nicht(FALSE) kein("") Feiertag, dann zähle weiter, oder verstehe ich dies falsch.
Wäre toll wenn mir das noch jemand erklären könnte.
Vielen Dank!
Gruß
Dr.
Moin,
vielen Dank für deine Hilfe, hab mir den Kopf zerbrochen und den Code noch einmal neu geschrieben um ihn besser zu verstehen und ich denke jetzt klappt es mit dem 2. und 6. Arbeitstag.
Function Arbeitstagermittlung(Wahl As Integer, Monat As Integer) As Variant
>
> Dim Datumzahl As Integer
> Dim wd As Integer
> Dim BestimmtesDatum As Date
> Dim Tageszahl As Integer
>
> Datumzahl = 0
>
> If Wahl < 3 Then
> Tageszahl = 0
> Do While Tageszahl <> 2
> Datumzahl = Datumzahl + 1
> If Feiertag(DateSerial(Year(Now()), Monat, Datumzahl), "") = False Then
> wd = Weekday(DateSerial(Year(Now()), Monat, Datumzahl), vbMonday)
> If wd < 6 Then
> Tageszahl = Tageszahl + 1
> BestimmtesDatum = DateSerial(Year(Now()), Monat, Datumzahl)
> End If
> End If
> Loop
>
> If Wahl = 2 Then
> Datumzahl = 0
> Tageszahl = 0
> Do While Tageszahl <> 6
> Datumzahl = Datumzahl + 1
> If Feiertag(DateSerial(Year(BestimmtesDatum), Month(BestimmtesDatum), Datumzahl), "") = False Then
> If Weekday(DateSerial(Year(BestimmtesDatum), Month(BestimmtesDatum), Datumzahl), vbMonday) < 6 Then
> Tageszahl = Tageszahl + 1
> BestimmtesDatum = DateSerial(Year(Now()), Monat, Datumzahl)
> End If
> End If
> Loop
> End If
> End If
>
> Arbeitstagermittlung = BestimmtesDatum
>
> End FunctionWas ich noch immer nicht ganz verstehe ich diese Feiertags Funktion, sie zählt also die einzelnen Tage vom Monat durch, ist davon einer ein Feiertag, dann zählt er diesen nicht, aber warum ist dann beim Feiertagsnamen ein "" eingetragen und dann auch noch ein FALSE am Ende?
If Feiertag(DateSerial(Year(Now()), Monat, DateCount), "") = False Then Ist der zu prüfende Tag nicht(FALSE) kein("") Feiertag, dann zähle weiter, oder verstehe ich dies falsch.
Wäre toll wenn mir das noch jemand erklären könnte.
Vielen Dank!
Gruß
Dr.
Ich glaub ich hab's gerade kapiert, da die Funktion eigentlich kein Boolean ist sondern ein Integer, gibt die Feiertagsfunktion entweder ein 0 oder 1 aus, FALSE ist das selbe wie 0, darum funktioniert der Code auch mit FALSE(könnte auch if Feiertag = 0 Then heißen).
Gruß
Dr.
Den Feiertagsnamen der Funktion als Paramater zu übergeben die ermittelt ob ein Datum ein Feiertag ist, ist sowie Quatsch 
Wenn dann müsster der Parameter ByRef (und nicht ByVal, was der default ist) übergeben werden.
Wenn dann müsster der Parameter ByRef (und nicht ByVal, was der default ist) übergeben werden.Ist der zu prüfende Tag nicht(FALSE) kein("") Feiertag, dann zähle weiter, oder verstehe ich dies falsch.
Nein, das siehst du richtig.
