Ich möchte Zeiten berechnen, welche innerhalb einer Periode liegen.
Beispiel:
Beginn Arbeitszeit 13:00
Ende Arbeitszeit: 00:39
Beginn Pause: 21:50
Ende Pause: 22:10
Es sollen aber nur die Zeiten berechnet werden, welche zwischen 22:00 und 6:00 liegen. Das Ergebnis des Beispiels muss also lauten: 02:29 (2:39 Stunden minus 10 Minuten Pause). Mit Formel kann ich das nicht machen, da die Formel 1449 Zeichen lang wäre. Bei 3660 solcher Formeln könnte die Arbeitsmappe sehr schnell instabil werden.
In Excel benutze ich daher folgende benutzerdefinierte Funktion (UDF).
Code: Alles auswählen
Rem Privates Modul. Makros in diesem Modul dürfen nicht über
Rem den Makrodialog ausführbar und die UDF nicht im
Rem Funktionsassistenten sichtbar sein.
Option Private Module
Rem Variablendeklaration erzwingen
Option Explicit
Rem Öffentlichen Typ erstellen
Type PeriodStartStop
Start As Double
Stop_ As Double
End Type
Rem *************************************************************************
Rem Beginn UDF "ZeitR"
Rem Erklärung Klammereinträge:
Rem Art: Schichtart, als Text ausgeben
Rem (as String). Angabe erforderlich
Rem BeginnArbeit: Beginn der Schicht, als Datum
Rem ausgeben (as Date). Angabe erforderlich
Rem EndeArbeit: Ende der Schicht, als Datum ausgeben
Rem (as Date). Angabe erforderlich
Rem ShiftStart: Beginn der zu berechnenden Periode,
Rem als Datum ausgeben (as Date). Angabe erforderlich
Rem ShiftEnd: Ende zu berechnenden Periode, als Datum
Rem ausgeben (as Date). Angabe erforderlich
Rem BeginnPauseEins: Beginn der 1. Pause, als Datum
Rem ausgeben (as Date). Angabe optional
Rem EndePauseEins: Ende der 1. Pause, als Datum ausgeben
Rem (as Date). Angabe optional
Rem BeginnPauseZwei, EndePauseZwei, BeginnPauseDrei
Rem und EndePauseDrei: wie PauseEins
Rem Beispiel Berechnung Nachtarbeit:
Rem Art = S (in A1)
Rem Beginn der Schicht 13:00 (in B1), Ende 00:39 (in C1).
Rem Beginn der zu berechnenden Zeit: 22:00 (in J1), Ende 06:00 (in K1)
Rem Beginn Pause: 21:50 (in D1), Ende 22:10 (in E1)
Rem Es soll nur Pausenzeit innerhalb der Periode berücksichtigt
Rem werden, also hier von 22:00 bis 22:10,
Rem die Pausezeit vor 22:00 soll hier nicht berücksichtigt werden.
Rem Das Ergebnis muss lauten: 02:29 (2 Stunden 29 Minuten Nachtarbeitszeit)
Rem Die notwendige Formel bei 1 Pause:
Rem =ZeitR(A1;B1;C1;J1;K1;D1;E1)
Rem oder Alternative Formel: =ZeitR(A1;B1;C1;"22:00";"06:00";D1;E1)
Rem Bei 3 Pausen lautet die Formel zum Beispiel:
Rem =ZeitR(A1;B1;C1;J1;K1;D1;E1;F1;G1;H1;I1)
Rem oder die alternative Formel:
Rem =ZeitR(A1;B1;C1;"22:00";"06:00";D1;E1;F1;G1;H1;I1)
Function ZeitR(Art As String, BeginnArbeit As Date, _
EndeArbeit As Date, ShiftStart As Date, ShiftEnd As Date, _
Optional BeginnPauseEins As Date, Optional EndePauseEins As Date, _
Optional BeginnPauseZwei As Date, Optional EndePauseZwei As Date, _
Optional BeginnPauseDrei As Date, Optional EndePauseDrei As Date) As Double
Rem Ende Einleitung
Rem **************************************************************************
Rem **************************************************************************
Rem Beginn Deklaration
On Error Resume Next
Dim i As Long
Dim j As Long
Dim Arbeit As Double
Dim PauseEins As Double
Dim PauseZwei As Double
Dim PauseDrei As Double
Dim Shift() As PeriodStartStop
Dim WorkedArbeit() As PeriodStartStop
Dim WorkedPauseEins() As PeriodStartStop
Dim WorkedPauseZwei() As PeriodStartStop
Dim WorkedPauseDrei() As PeriodStartStop
Rem Ende Deklaration
Rem ***************************************************************************
Rem ***************************************************************************
Rem Beginn Berechnung
Rem Kommen und Gehen
GetPeriods CDbl(BeginnArbeit), CDbl(EndeArbeit), WorkedArbeit()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
Arbeit = 0
For i = 0 To UBound(WorkedArbeit())
For j = 0 To UBound(Shift())
Arbeit = Arbeit + GetOverlap(WorkedArbeit(i), Shift(j))
Next j
Next i
Rem Gehen und Kommen Pause 1
GetPeriods CDbl(BeginnPauseEins), CDbl(EndePauseEins), WorkedPauseEins()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
PauseEins = 0
For i = 0 To UBound(WorkedPauseEins())
For j = 0 To UBound(Shift())
PauseEins = PauseEins + GetOverlap(WorkedPauseEins(i), Shift(j))
Next j
Next i
Rem Gehen und Kommen Pause 2
GetPeriods CDbl(BeginnPauseZwei), CDbl(EndePauseZwei), WorkedPauseZwei()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
PauseZwei = 0
For i = 0 To UBound(WorkedPauseZwei())
For j = 0 To UBound(Shift())
PauseZwei = PauseZwei + GetOverlap(WorkedPauseZwei(i), Shift(j))
Next j
Next i
Rem Gehen und Kommen Pause 3
GetPeriods CDbl(BeginnPauseDrei), CDbl(EndePauseDrei), WorkedPauseDrei()
GetPeriods CDbl(ShiftStart), CDbl(ShiftEnd), Shift()
PauseDrei = 0
For i = 0 To UBound(WorkedPauseDrei())
For j = 0 To UBound(Shift())
PauseDrei = PauseDrei + GetOverlap(WorkedPauseDrei(i), Shift(j))
Next j
Next i
Rem Ende Berechnung
Rem Endberechnung
Rem Art (Spalte Art) = M, U oder K dann 0
If Art = "M" Or Art = "U" Or Art = "K" Then
ZeitR = 0
Else
Rem Zuerst wird die errechnete Arbeitszeit in das Dezimalformat
Rem konvertiert und gerundet. Danach werden die Pausenzeiten
Rem in das Dezimalformat konvertiert, gerunden und miteinander
Rem addiert. Das Ergebnis wird dann von der errechneten Arbeitszeit abgezogen.
Rem Zum Schluß wird das Gesamtergebnis wieder in das Zeitformat konvertiert.
ZeitR = (Round(Arbeit * 24, 5) - (Round(PauseEins * 24, 5) + _
Round(PauseZwei * 24, 5) + Round(PauseDrei * 24, 5))) / 24
End If
Rem Ende Endberechnung
End Function
Rem Ende UDF "ZeitR"
Rem ***************************************************************************
Rem Beginn Routine "GetPeriods"
Private Sub GetPeriods(ByVal t1 As Double, ByVal t2 As Double, _
Period() As PeriodStartStop)
t1 = t1 - Int(t1)
t2 = t2 - Int(t2)
If t1 <= t2 Then
ReDim Period(0 To 0)
Period(0).Start = t1
Period(0).Stop_ = t2
Else
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
Rem Ende Routine "GetPeriods"
Rem Beginn UDF "GetOverlap"
Private Function GetOverlap(Period1 As PeriodStartStop, _
Period2 As PeriodStartStop) As Double
Dim t1 As Double
Dim t2 As Double
If Period1.Start >= Period2.Start Then
t1 = Period1.Start
Else
t1 = Period2.Start
End If
If Period1.Stop_ <= Period2.Stop_ Then
t2 = Period1.Stop_
Else
t2 = Period2.Stop_
End If
t2 = t2 - t1
If t2 < 0 Then t2 = 0
GetOverlap = t2
End Function
Rem Ende UDf "GetOverlap"Kennt jemand eine vernünftige deutschsprachige Starbasic-Dokumentation? Englisch kann ich nicht, sonst wäre es einfach. Danke!
Gruß, René
