collapse

* Benutzer Info

 
 
Willkommen Gast. Bitte einloggen oder registrieren. Haben Sie Ihre Aktivierungs E-Mail übersehen?

* Wer ist Online

  • Punkt Gäste: 68
  • Punkt Versteckte: 1
  • Punkt Mitglieder: 6
  • Punkt Benutzer Online:

* Forenstatistik

  • stats Mitglieder insgesamt: 13804
  • stats Beiträge insgesamt: 63512
  • stats Themen insgesamt: 8606
  • stats Kategorien insgesamt: 5
  • stats Boards insgesamt: 16
  • stats Am meisten online: 415

Autor Thema: datediff nur businessdays in Stunden  (Gelesen 246 mal)

Offline jake012

  • Newbie
  • Beiträge: 11
datediff nur businessdays in Stunden
« am: November 16, 2017, 22:00:49 »
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
 

Offline Frithjiof

  • Newbie
  • Beiträge: 41
Re: datediff nur businessdays in Stunden
« Antwort #1 am: November 16, 2017, 23:20:00 »
Hallo Jake

Hier ist 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
 

Offline Lachtaube

  • Access-Meister
  • ***
  • Beiträge: 854
Re: datediff nur businessdays in Stunden
« Antwort #2 am: November 17, 2017, 00:09:40 »
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, der etwas abgewandelt, auch auf Dein Problem zutreffen dürfte, diskutiert.
Grüße von der (⌒▽⌒)
 

Offline jake012

  • Newbie
  • Beiträge: 11
Re: datediff nur businessdays in Stunden
« Antwort #3 am: November 17, 2017, 15:02:02 »
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.
 

Offline ebs17

  • Access-Meister
  • ***
  • Beiträge: 819
Re: datediff nur businessdays in Stunden
« Antwort #4 am: November 17, 2017, 15:32:06 »
Zitat
Wochenende 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.

Mit freundlichem Glück Auf!

Eberhard
 

Offline Lachtaube

  • Access-Meister
  • ***
  • Beiträge: 854
Re: datediff nur businessdays in Stunden
« Antwort #5 am: November 17, 2017, 15:56:55 »
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)
 1416
An der kommentierten Stelle im Code müsstest Du dann noch die Feiertagsgeschichte einpflegen.
Grüße von der (⌒▽⌒)
 

Offline jake012

  • Newbie
  • Beiträge: 11
Re: datediff nur businessdays in Stunden
« Antwort #6 am: November 21, 2017, 11:03:07 »
@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)
 

Offline ebs17

  • Access-Meister
  • ***
  • Beiträge: 819
Re: datediff nur businessdays in Stunden
« Antwort #7 am: November 21, 2017, 11:33:19 »
Mit freundlichem Glück Auf!

Eberhard
 

Offline Lachtaube

  • Access-Meister
  • ***
  • Beiträge: 854
Re: datediff nur businessdays in Stunden
« Antwort #8 am: November 21, 2017, 11:37:21 »
Nun, dann musst Du Dir eine Feiertagsimplementierung (z. Bsp. (Bewegliche) Feiertage bestimmen) besorgen, die für einen Datumswert ausgibt, ob es sich um einen Feiertag handelt oder nicht.
Grüße von der (⌒▽⌒)
 

Offline jake012

  • Newbie
  • Beiträge: 11
Re: datediff nur businessdays in Stunden
« Antwort #9 am: November 21, 2017, 11:54:49 »
@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.
 

Offline ebs17

  • Access-Meister
  • ***
  • Beiträge: 819
Re: datediff nur businessdays in Stunden
« Antwort #10 am: November 21, 2017, 13:08:16 »
Zitat
es 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.
« Letzte Änderung: November 21, 2017, 13:55:13 von ebs17 »
Mit freundlichem Glück Auf!

Eberhard
 

Offline jake012

  • Newbie
  • Beiträge: 11
Re: datediff nur businessdays in Stunden
« Antwort #11 am: November 21, 2017, 14:18:35 »
@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.
 

Offline Lachtaube

  • Access-Meister
  • ***
  • Beiträge: 854
Re: datediff nur businessdays in Stunden
« Antwort #12 am: November 21, 2017, 14:48:54 »
Nun, eigentlich musst Du nur das Kopieren und Einfügen von VBA-Code beherrschen. ;D
Grüße von der (⌒▽⌒)
 
Folgende Mitglieder bedankten sich: jake012

Offline jake012

  • Newbie
  • Beiträge: 11
Re: datediff nur businessdays in Stunden
« Antwort #13 am: November 22, 2017, 11:23:37 »
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.
 

Offline Lachtaube

  • Access-Meister
  • ***
  • Beiträge: 854
Re: datediff nur businessdays in Stunden
« Antwort #14 am: November 22, 2017, 18:37:07 »
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
Grüße von der (⌒▽⌒)
 
Folgende Mitglieder bedankten sich: jake012