AW: Laufzeit ohne Wochenende berechnen
15.10.2019 10:11:09
Sigi
Hallo Andreas,
mit VBA lassen sich deine Probleme lösen. Starttermin kann Wochenende, Feiertag oder Arbeitstag sein. Völlig egal. Bei den Feiertagen musst du halt die Tage für deine Region aktivieren.
Startdatum mit Uhrzeit (im Format TT.MM.JJJJ hh:mm) dann VBA-Funktion (mit Unterfunktion, freie Tage):
Function LaufzeitEnde(Start As Date, Dauer As Date) As Date
Dim Dat As Date, Skn As Double, RD As Double
Dim SkV As Double, SkB As Double, TD As Double
Const ZF As Long = 1440
Application.Volatile
SkV = 0
SkB = Round(CDbl(1 * ZF), 0)
TD = SkB - SkV
Dat = CDate(Int(CDbl(Start)))
Skn = Round(CDbl(Start - Dat) * ZF, 0)
RD = Round(CDbl(Dauer) * ZF, 0)
If RD > 0 And Skn
Skn = SkV
ElseIf RD > 0 And Skn > SkB Then
Dat = Dat + 1
Skn = SkV
End If
Do While RD > 0
If Not IstFrei(Dat) Then
Do While RD > 0 And Skn = SkV
Skn = Skn + 1
RD = RD - 1
Loop
If RD > 0 And RD > TD Then
Do While RD > TD
Dat = Dat + 1
If Not IstFrei(Dat) Then
RD = RD - TD
End If
Loop
End If
If RD > 0 Then
Dat = Dat + 1
Skn = SkV
End If
Else
Dat = Dat + 1
Skn = SkV
End If
Loop
LaufzeitEnde = Dat + Skn / ZF
End Function
Private Function IstFrei(Dat As Date) As Boolean
Dim FreierTag As Range
Dim frei As Boolean
Dim JJ As Long
Dim DD As Long
Dim OS As Date
If Weekday(Dat, vbMonday) > 5 Then frei = True: GoTo RAUS 'WoE.
JJ = Year(Dat)
If Dat = DateSerial(JJ, 1, 1) Then frei = True: GoTo RAUS 'Neuj.
'If Dat = DateSerial(JJ, 1, 2) Then frei = True: GoTo RAUS 'Ber.
If Dat = DateSerial(JJ, 1, 6) Then frei = True: GoTo RAUS '3K?.
'If Dat = DateSerial(JJ, 3, 8) Then frei = True: GoTo RAUS 'int.Fr.t.
If Dat = DateSerial(JJ, 5, 1) Then frei = True: GoTo RAUS 'Maif.
'If Dat = DateSerial(JJ, 8, 1) Then frei = True: GoTo RAUS 'Bun.f.
'If Dat = DateSerial(JJ, 8, 8) Then frei = True: GoTo RAUS 'Fri.f.
If Dat = DateSerial(JJ, 8, 15) Then frei = True: GoTo RAUS 'Mar.H.
'If Dat = DateSerial(JJ, 9, 20) Then frei = True: GoTo RAUS 'W.K.t.
If Dat = DateSerial(JJ, 10, 3) Then frei = True: GoTo RAUS 'dt.Einh.
'If Dat = DateSerial(JJ, 10, 31) Then frei = True: GoTo RAUS 'Ref.
If Dat = DateSerial(JJ, 11, 1) Then frei = True: GoTo RAUS 'Allh.
'If Dat = DateSerial(JJ, 11, 23) - _
Weekday(DateSerial(JJ, 12, 24)) _
Then frei = True: GoTo RAUS 'BuB
'If Dat = DateSerial(JJ, 11, 26) Then frei = True: GoTo RAUS 'Nat.f.
'If Dat = DateSerial(JJ, 12, 8) Then frei = True: GoTo RAUS 'Mar.Emp.
If Dat = DateSerial(JJ, 12, 24) Then frei = True: GoTo RAUS 'hl.Abd.
If Dat = DateSerial(JJ, 12, 25) Then frei = True: GoTo RAUS 'Whn1
If Dat = DateSerial(JJ, 12, 26) Then frei = True: GoTo RAUS 'Whn2
If Dat = DateSerial(JJ, 12, 31) Then frei = True: GoTo RAUS 'Silv.
DD = (((255 - 11 * (JJ Mod 19)) - 21) Mod 30) + 21
OS = DateSerial(JJ, 3, 1) + DD + (DD > 48) + 6 - ((JJ + JJ \ 4 + DD + (DD > 48) + 1) Mod 7)
If Dat = OS - 2 Then frei = True: GoTo RAUS 'KarFr.
If Dat = OS + 1 Then frei = True: GoTo RAUS 'OstMo.
If Dat = OS + 39 Then frei = True: GoTo RAUS 'ChrH.
If Dat = OS + 50 Then frei = True: GoTo RAUS 'PfiMo.
If Dat = OS + 60 Then frei = True: GoTo RAUS 'Fronl.
RAUS:
IstFrei = frei
End Function
Grüße
Sigi