Hi,
habe mich unten beschriebenen Code bedient, welcher mir die Differenz zw. 2 Tagen excl. Wochenende und Feiertage darstellt.
datum1 hat den Wert: 13.11.2017 11:23:43
datum2 hat den Wert: 15.11.2017 17:00:03
Der Code sagt mir, dass es 2 Tage Differenz sind.
1. möchte ich die Ausgabe nicht mehr in Tagen, sondern in tatsächliche Minuten haben.
2. Sollen die tatsächlichen Minuten nur zwischen 2 definierten Werten gezählt werden (zum Beispiel nur zwischen 9 Uhr und 18 Uhr).
Die Lösung soll nun also nicht mehr 2 Tage sein, sondern 1403 Minuten
(Rechnung:
13.11.=383
+14.11.=540
+15.11.=480).
Leider bin ich nicht sehr VBA-Versiert und habe noch keine Lösung finden können, die mir das richtige Ergebnis liefert, sofern das überhaupt möglich ist mit dieser Funktion.
Würde mich also sehr über Lösungsansätze freuen :)
Viele Grüße
Jake
Function fktWerktage (datum1 As Variant, datum2 As String)
'Die Funktion ermittelt die Anzahl der Werktage zwischen Datum1 und Datum2
unter
'Berücksichtigung der deutschen Feiertage
On Error Resume Next
Dim lngAnzahl As Long
Dim lngTag As Long
Dim i As Integer
'zunächst wir die Anzahl der Kalendertage für die Durchläufe
'der Schleife ermittelt
lngAnzahl = DateDiff("y", datum1, datum2)
'die Anzahl der Tage wird auf 0 gesetzt
lngTag = 0
'Die Überprüfung kann nun beginnen
For i = 1 To lngAnzahl
' Prüfung ob Sonntag (1) oder Samstag (7)
If Weekday(datum1) = 1 Or Weekday(datum1) = 7 Then
'ist dies der Fall, so bleibt die Anzahl der Tage
lngTag = lngTag
Else
'und falls nicht, wird die Anzahl um 1 Tag erhöht
lngTag = lngTag + 1
End If
'Debug.Print lngTag
'Debug.Print datum1
'nun werden die Feiertage geprüft
'falls wir nochmals auf Samstag oder Sonntag stoßen,
'so bleibt wiederum die Anzahl der Tage
If Weekday(datum1) = 1 Or Weekday(datum1) = 7 Then
lngTag = lngTag
Else
'haben wir aber Mo, Di, Mi, Do oder Fr und dazu noch Feiertag
'so wird ein Tag abgezogen
If Feiertag(datum1) <> "" Then
'Debug.Print datum1
lngTag = lngTag - 1
End If
End If
'das Datum wird um einen Tag erhöht
datum1 = DateValue(datum1) + 1
'Debug.Print datum1
Next i
fktWerktage = lngTag
End Function
Function Feiertag (Datum As Variant)
Dim Jahr As Integer, Monat As Integer, Tag As Integer, S As Long
Dim M As Integer, N As Integer, I As Integer, J As Integer, T As Integer
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As Integer
'************ Feiertagsberechnung *****************
Jahr = Year(Datum)
Monat = Month(Datum)
Tag = Day(Datum)
S = DateSerial(Jahr, Monat, Tag)
'************ feste Feiertage *****************
If (Monat = 1) And (Tag = 1) Then
Feiertag = "Neujahr"
GoTo Ende
End If
If (Monat = 5) And (Tag = 1) Then
Feiertag = "Maifeiertag"
GoTo Ende
End If
If (Monat = 10) And (Tag = 3) Then
Feiertag = "Tag der Deutschen Einheit"
GoTo Ende
End If
If (Monat = 11) And (Tag = 1) Then
Feiertag = "Allerheiligen"
GoTo Ende
End If
If (Monat = 12) And (Tag = 24) Then
Feiertag = "Heiligabend"
GoTo Ende
End If
If (Monat = 12) And (Tag = 25) Then
Feiertag = "1. Weihnachtstag"
GoTo Ende
End If
If (Monat = 12) And (Tag = 26) Then
Feiertag = "2. Weihnachtstag"
GoTo Ende
End If
If (Monat = 12) And (Tag = 31) Then
Feiertag = "Silvester"
GoTo Ende
End If
'************ variable Feiertage *****************
ReDim Feiertagsname(1 To 11) As String
ReDim Feiertagsdatum(1 To 11) As Variant
Select Case Jahr
Case 1582 To 1699
M = 22
N = 2
Case 1700 To 1799
M = 23
N = 3
Case 1800 To 1899
M = 23
N = 4
Case 1900 To 2099
M = 24
N = 5
Case 2100 To 2199
M = 24
N = 6
End Select
J = Jahr
A = J Mod 19
B = J Mod 4
C = J Mod 7
D = (19 * A + M) Mod 30
E = (2 * B + 4 * C + 6 * D + N) Mod 7
If (D + E) <= 9 Then
Feiertagsdatum(3) = DateSerial(Jahr, 3, 22 + D + E)
Else
Feiertagsdatum(3) = DateSerial(Jahr, 4, D + E - 9)
End If
If Month(Feiertagsdatum(3)) = 4 Then
If (D = 28) And (A > 10) Then
If Day(Feiertagsdatum(3)) = 25 Then
Feiertagsdatum(3) = DateSerial(Jahr, 4, 18)
End If
If Day(Feiertagsdatum(3)) = 26 Then
Feiertagsdatum(3) = DateSerial(Jahr, 4, 19)
End If
End If
End If
Feiertagsname(1) = "Rosenmontag"
Feiertagsname(2) = "Karfreitag"
Feiertagsname(3) = "Ostersonntag"
Feiertagsname(4) = "Ostermontag"
Feiertagsname(5) = "Christi Himmelfahrt"
Feiertagsname(6) = "Pfingstsonntag"
Feiertagsname(7) = "Pfingstmontag"
Feiertagsname(8) = "Fronleichnam"
Feiertagsname(9) = "Buß- und Bettag"
Feiertagsname(10) = "Ostersamstag"
Feiertagsname(11) = "Pfingstssamstag"
Feiertagsdatum(1) = Feiertagsdatum(3) - 48
Feiertagsdatum(2) = Feiertagsdatum(3) - 2
Feiertagsdatum(4) = Feiertagsdatum(3) + 1
Feiertagsdatum(5) = Feiertagsdatum(3) + 39
Feiertagsdatum(6) = Feiertagsdatum(3) + 49
Feiertagsdatum(7) = Feiertagsdatum(3) + 50
Feiertagsdatum(8) = Feiertagsdatum(3) + 60
Feiertagsdatum(10) = Feiertagsdatum(3) - 1
Feiertagsdatum(11) = Feiertagsdatum(6) - 1
For T = 16 To 22
If Weekday(DateSerial(Jahr, 11, T)) = 4 Then Feiertagsdatum(9) =
DateSerial(Jahr, 11, T)
Next T
For I = 1 To 11
If Datum = Feiertagsdatum(I) Then
Feiertag = Feiertagsname(I)
GoTo Ende
End If
Next I
'************ kein Feiertag *****************
Feiertag = ""
Ende:
End Function
Hallo Jake
Hier ist (https://msdn.microsoft.com/de-de/VBA/language-reference-vba/articles/datediff-function) eine Beschreibung der DateDiff-Funktion.
Hier ein Beispiel
Sub xtest()
Dim datum1 As Date
Dim datum2 As Date
datum1 = "13.11.2017 11:23:43"
datum2 = "15.11.2017 17:00:03"
MsgBox "Tage:" & DateDiff("d", datum1, datum2)
MsgBox "Stunden:" & DateDiff("h", datum1, datum2)
MsgBox "Minuten:" & DateDiff("n", datum1, datum2)
MsgBox "Sekunden:" & DateDiff("s", datum1, datum2)
End Sub
Frithjof
In welcher Form Du die Differenz ausgibst, ist eine Frage der Skalierung. Alle Zeitangaben, die nicht vor dem letzten Jahrhundert liegen, kannst Du durch einfache Subtraktion ermitteln, was viel schneller als die DateXXX-Funktionen ist. Eine ähnliche Aufgabe hatten wir vor kurzem hier im Beitrag Nachtarbeitsstunden berechnen (http://www.access-o-mania.de/forum/index.php?topic=22762), der etwas abgewandelt, auch auf Dein Problem zutreffen dürfte, diskutiert.
Hi Lachtaube,
abgewandelte Themen habe ich leider schon viele gefunden, die mir aber ebenso nicht weiterhelfen konnten :/
"...eine Frage der Skalierung..." Frage: wie kann ich diese mit dem von mir verwendeten Code ändern? (den Wert in der VBA [lngAnzahl = DateDiff("y", datum1, datum2)] ändern in [lngAnzahl = DateDiff("n", datum1, datum2)] zeigt keine richtige Minutenangabe.
Du hast auch geschrieben "...durch einfache Subtraktion ermitteln..." Bitte was? Das führt doch dazu, wenn ich die Differenz zwischen 09.11. und 16.11. haben will, 7 Tage, bzw. 10080 Minuten das Ergebnis ist.
Genau DAS brauch ich nicht. Wochenende und Feiertage sollen ja übersprungen werden und zusätzlich nur innerhalb der Business-hours gezählt werden.
Beim Beispiel vom 09.11.2017 08:00:00 bis 16.11.2017 14:00:00 wären dass dann 6600 Minuten anstatt 10080 Minuten.
@Frithjiof: Danke, aber die Beschreibung der datediff kenne ich per sé schon.
ZitatWochenende und Feiertage sollen ja übersprungen werden und zusätzlich nur innerhalb der Business-hours gezählt werden.
Ist Dir auch die Abfragelösung aus dem angegebenen Link ins Bewusstsein gedrungen? In welcher Art?
Ansonsten, wenn Du VBA-mäßig stückeln willst, könntest Du etwa so vorgehen:
- Du ermittelst die Minuten am Starttag und am Endetag.
- Du ermittelst die dazwischen liegenden vollen Werktage eigener Definition und daraus die Minutenzahl.
- Das Ganze wird addiert.
Anscheinend hast Du den Thread nicht gelsesen oder nicht verstanden. ;)
Public Function Min(ByRef a As Variant, ByRef b As Variant) As Variant
If a < b Then Min = a Else Min = b
End Function
Public Function Max(ByRef a As Variant, ByRef b As Variant) As Variant
If a > b Then Max = a Else Max = b
End Function
Public Function RangeOverlap( _
ByRef Range1Start As Variant, _
ByRef Range1End As Variant, _
ByRef Range2Start As Variant, _
ByRef Range2End As Variant) As Variant
RangeOverlap = Max(Min(Range1End, Range2End) - Max(Range1Start, Range2Start), 0)
End Function
'eine Implementierung mit Tagesausschlüssen
'Im Code weiter unten entsprechende Kommentare '!!! entfernen und
'ParamArray mit Empty, oder mit einer Liste von Wochentagen bestücken
Public Function TimeSpan( _
ByVal TimeStart As Date, _
ByVal TimeEnd As Date, _
ByVal SliceStart As Date, _
ByVal SliceEnd As Date, _
ParamArray ExcludedWeekdays() As Variant) As Date
'Public Function TimeSpan( _
' ByVal TimeStart As Date, _
' ByVal TimeEnd As Date, _
' ByVal SliceStart As Date, _
' ByVal SliceEnd As Date) As Date
Dim DayStart As Date
Dim DayEnd As Date
Dim i As Long
Dim j As Long
Dim WDay As VbDayOfWeek
For i = Int(TimeStart) To Int(TimeEnd)
WDay = Weekday(i)
For j = 0 To UBound(ExcludedWeekdays)
If WDay = ExcludedWeekdays(j) Then GoTo NextDay
'If WDay = DeineFeiertagsFunktion Then GoTo NextDay
Next
'Start um Mitternacht, außer ggf. beim ersten Tag
DayStart = Max(TimeStart, i)
'Ende um Mitternacht des nächsten Tages, außer ggf. beim letzten Tag
DayEnd = Min(TimeEnd, i + 1)
'Zeitspanne aufaddieren
TimeSpan = TimeSpan + DayEnd - DayStart
If SliceStart < SliceEnd Then
'Zeit vom Tagesanfang bis Bereichsanfang subtrahieren
TimeSpan = TimeSpan - RangeOverlap(DayStart, DayEnd, i, i + SliceStart)
'Zeit ab Bereichsende subtrahieren
TimeSpan = TimeSpan - RangeOverlap(DayStart, DayEnd, i + SliceEnd, i + 1)
Else
'Zeit zwischen Bereichsanfang und Bereichsende subtrahieren; Ende < Start!!!
TimeSpan = TimeSpan - RangeOverlap(DayStart, DayEnd, i + SliceEnd, i + SliceStart)
End If
NextDay:
Next
End Function
Test im VBA-Direktbereich:?CLng(TimeSpan(#2017-11-09#, #2017-11-16#, #09:00#, #18:00#, vbSaturday, vbSunday)*1440)
2700
?CLng(TimeSpan(#2017-11-13 11:23:43#, #2017-11-15 17:00:03#, #09:00#, #18:00#, vbSaturday, vbSunday)*1440)
1416An der kommentierten Stelle im Code müsstest Du dann noch die Feiertagsgeschichte einpflegen.
@lachtaube, die Lösung kann ich wohl soweit nachvollziehen und verstehe auch, dass ich mit dem ExcludedWeekdays Wochentage ausschließen kann. Aber umschreiben, dass das bei mir funktioniert, bekomme ich leider trotzdem nicht hin.
Ich kann ja nicht einfach, wie du geschrieben hast, "If Wday = fktWerktage(j) then GoTo NextDay" machen. Die Funktion fktWerktage berechnet ja schon sämtliche zu zählende Tage.
Ich habe dann gedacht: Gut, machst du eine Calendertabelle statt Funktion. Doch wie soll ich die nur einbinden? Und was muss dass dann für ein Calender sein? Einer mit sämtlichen Positiv-Daten oder eine mit Negativdaten (also Wochenenden und Feiertage)?
@ebs17: Abfragelösung kann ich nachvollziehen. Kann es nur nicht umsetzen. Dazu verstehe ich noch zu wenig davon (wird aber stetig mehr; will das ja auch verstehen)
ZitatDazu verstehe ich noch zu wenig davon
Grundlagen - SQL ist leicht (6) - Komplexe Abfragen schreiben und lesen (http://www.ms-office-forum.net/forum/showthread.php?t=317066)
Nun, dann musst Du Dir eine Feiertagsimplementierung (z. Bsp. (Bewegliche) Feiertage bestimmen) (http://vb-tec.de/feiertag.htm) besorgen, die für einen Datumswert ausgibt, ob es sich um einen Feiertag handelt oder nicht.
@ebs17: es geht aber um vba und nicht um sql. Auch geht es nicht um Aliasvergaben. Leider hilft mir der Link so gar nicht weiter.
@Lachtaube, das habe ich doch schon mit der im Eingangspost gezeigten Funktionen. Ich kann diese und deine aber nicht verknüpfen, weil ich nicht weiß, wie.
Zitates geht aber um vba und nicht um sql
Ach, ich Dummer.
Wenn jemand in Access programmiert, also in einer Datenbankentwicklungsumgebung, unterstelle ich immer, dass man nicht Berechnungen einmalig ausführen will auf einen einmaligen Vorgang, sondern dass man mehrere (viele?) Vorgänge hat (womöglich sogar Tabellen, die so etwas enthalten), die in einem Zug abgearbeitet werden sollen. Daher denke ich da primär an Methoden der Massendatenverarbeitung.
Das Erstaunliche ist dann, eine Umsetzung, die für 100k Datensätze tauglich ist, lässt sich auch auf einen einzelnen Datensatz anwenden.
Nein, ein jedesmaliges Neuberechnen per VBA pro Datensatz, ob im Zeitraum Ostermontag oder Weihnachten enthalten ist, ist natürlich viel spannender.
@ebs17: Hilft mir als Anfänger nicht gerade weiter.
Wenn es nach mir gehen würde, sollte der einfach die Berechnung machen und die Tage ausschließen, die in meiner Tabelle den Flag wochendende=true und Feiertag=true haben. Da brauch dann keiner berechnen, wann Ostermontag ist.
Nun, eigentlich musst Du nur das Kopieren und Einfügen von VBA-Code beherrschen. ;D
Hi Lachtaube,
vielen Dank für das Beispiel. Jetzt habe ich verstanden, wie ich das überhaupt einbauen kann:
...
For j = 0 To UBound(ExcludedWeekdays)
If WDay = ExcludedWeekdays(j) Then GoTo NextDay
If IstFeiertag(i) Then GoTo NextDay
...
Bin ich davon ausgegangen, dass da noch ein Next dazwischen muss. Wusste nicht, dass das so hintereinander weg geschrieben werden kann.
Habe nun meine Abfrage abgeändert
CLng(TimeSpan(Anfang,Ende,#12/30/1899 9:0:0#,#12/30/1899 18:0:0#,1,7)*1440) AS Minuten)
Meine alte Feiertagsfunktion habe ich dennoch nicht weiter verwenden können... Irgendetwas stört da, was ich aber nicht debuggen kann... Habe deshalb die von dir zur Verfügung gestellten Feiertagsfunktion übernommen.
Im ersten Test sieht es gut aus. Werde noch weiter testen und mal gucken, ob ich nicht doch noch in einer ruhigen Minute herausfinde, warum ich meine Feiertagsfunktion nicht ausführen kann.
Gute Anmerkung - da muss ich wohl geträumt haben. ;D Außerhalb der For/Next-Schleife ist die Feiertagsprüfung natürlich angemessener plaziert (eine Prüfung je Tag ist ausreichend). For j = 0 To UBound(ExcludedWeekdays)
If WDay = ExcludedWeekdays(j) Then GoTo NextDay
'If IstFeiertag(i) Then GoTo NextDay
Next
If IstFeiertag(i) Then GoTo NextDay
Also wenn ich da jetzt ein Next zwischen setze, bekomme ich aber einen Fehler beim Kompilieren: "Next ohne For"
Du sollst nichts dazwischen setzen, sondern die Feiertagstagsprüfung aus der Schleife nehmen und gleich unterhalb der Next-Anweisung platzieren, damit sie nicht unnötig oft ausgeführt wird.