Aus XIMES
Option Explicit
'
Function Überschneidung(Zeit_A_Von As Double, Zeit_A_Bis As Double, Zeit_B_Von As Double, Zeit_B_Bis As Double, Optional VONgleichBIS_Ist_24h As Boolean = False, Optional IchBinSchonInRekursion_Start_Mit_False As Boolean = False) As Double
' Berechnet wie weit sich zwei Zeiten überschneiden
' Es können Tageszeiten übergeben werden, aber auch Datum und Uhrzeit
'IchBinSchonInRekursion_Start_Mit_False ... ist bei normalem Aufrauf FALSCH bzw. auf False gesetzt
'VONgleichBIS_Ist_24h .... wenn TRUE bzw. Wahr gesetzt wird zB bei Zeiten die ident sind, 1 Tag dazugezahält
Dim Start, Ende As Double
'
'*** Anpassen Umgang mit 24h Interval
' Wenn Von=Bis
If Zeit_A_Von > Zeit_A_Bis Then Zeit_A_Bis = Zeit_A_Bis + 1
If Zeit_B_Von > Zeit_B_Bis Then Zeit_B_Bis = Zeit_B_Bis + 1
If Zeit_A_Von = Zeit_A_Bis And VONgleichBIS_Ist_24h And Zeit_A_Von < 1 Then Zeit_A_Bis = Zeit_A_Bis + 1
If Zeit_B_Von = Zeit_B_Bis And VONgleichBIS_Ist_24h And Zeit_B_Von < 1 Then Zeit_B_Bis = Zeit_B_Bis + 1
'
Start = Application.WorksheetFunction.Max(Zeit_A_Von, Zeit_B_Von)
Ende = Application.WorksheetFunction.Min(Zeit_A_Bis, Zeit_B_Bis)
'
Überschneidung = Ende - Start
'
'Der rekursive Aufruf fängt um Tage verschobenes ab.
'Mit OPtional false ist sichergestellt, dass er nur einmal aufgerufen wird.
If Überschneidung <= 0 And (Not IchBinSchonInRekursion_Start_Mit_False) Then
Überschneidung = Überschneidung(Zeit_A_Von + 1, Zeit_A_Bis + 1, Zeit_B_Von, Zeit_B_Bis, ,True)
End If
'
If Überschneidung <= 0 And (Not IchBinSchonInRekursion_Start_Mit_False) Then
Überschneidung = Überschneidung(Zeit_A_Von, Zeit_A_Bis, Zeit_B_Von + 1, Zeit_B_Bis + 1, ,True)
End If
'
If Überschneidung < 0 Then Überschneidung = 0
'
End Function
