HERBERS Excel-Forum - die Beispiele

Thema: Nachtstunden ermitteln und Lohn errechnen

Home

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.

Lösung
Geben Sie die nachfolgende benutzerdefinierte Funktion in ein Standardmodul ein.
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