Gruppe
DatumZeit
Problem
Die Arbeitszeit soll gem. den Daten in Spalte J in Normal- und Nachtstunden gesplittet werden. Der Lohn ist auf dieser Grundlage zu ermitteln.
StandardModule: Modul1
Type PeriodStartStop
Start As Double
Stop_ As Double
End Type
Function ShiftHours(InTime As Date, OutTime As Date, _
Optional ShiftStart As Date, _
Optional ShiftEnd As Date) As Double
Dim i As Long
Dim j As Long
Dim N As Double
Dim Shift() As PeriodStartStop
Dim Worked() As PeriodStartStop
'if worked hours don't span midnight, there's just one period; if do
'span midnight, will break into 2 periods, before and after midnight
GetPeriods CDbl(InTime), CDbl(OutTime), Worked()
'ditto for the shift
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
'get overlap of each worked period with each shift period
N = 0
For i = 0 To UBound(Worked())
For j = 0 To UBound(Shift())
N = N + GetOverlap(Worked(i), Shift(j))
Next j
Next i
ShiftHours = Round(N * 24, 5)
End Function
Private Sub GetPeriods(ByVal t1 As Double, ByVal t2 As Double, _
Period() As PeriodStartStop)
'NB: t1 and t2 are time values 0 <= t < 1, not hours
t1 = t1 - Int(t1)
t2 = t2 - Int(t2)
'does period span midnight?
If t1 <= t2 Then
'no: just one period
ReDim Period(0 To 0)
Period(0).Start = t1
Period(0).Stop_ = t2
Else
'yes: split into 2 periods: t1 to midnight, midnight to t2
'note: in 1st period midnight = 1, in 2nd period, midnight = 0
ReDim Period(0 To 1)
Period(0).Start = t1
Period(0).Stop_ = 1
Period(1).Start = 0
Period(1).Stop_ = t2
End If
End Sub
Private Function GetOverlap(Period1 As PeriodStartStop, _
Period2 As PeriodStartStop) As Double
Dim t1 As Double
Dim t2 As Double
'NB: Stop_ must never be less than Start, which is
'ensured by splitting periods that span midnight
'into 2 periods
'overlap, if any, is from later start to earlier end
'get the later of the start times
If Period1.Start >= Period2.Start Then
t1 = Period1.Start
Else
t1 = Period2.Start
End If
'get the earlier of the Stop_ times
If Period1.Stop_ <= Period2.Stop_ Then
t2 = Period1.Stop_
Else
t2 = Period2.Stop_
End If
'subtract start from stop to get length of interval
'if result is positive, this is length of overlap
'if result = 0, one period starts when the other ends
'if result < 0, the periods don't overlap; result
' is the size of the gap between periods;
'since we are only interested in overlap,
'change negative result to 0
t2 = t2 - t1
If t2 < 0 Then t2 = 0
GetOverlap = t2
End Function