In meinem Arbeitsblatt möchte ich die voraussichtlichen Endzeiten von Prozessen berechnen.
Ich möchte dies jedoch auf eine vorgegebene Zeitbeschränkung beschränken. Wenn ich also beispielsweise 4 Stunden zu 14:00 addiere, möchte ich nicht, dass das Ergebnis 18:00 ist, sondern 9:00!
Unter der Annahme von Arbeitstagen von 8:00 bis 17:00 Uhr. Und ohne Samstag und Sonntag
Kann mir jemand helfen?
Mit Hilfe von Simon bei rcl gelang es mir, seine Lösung so anzupassen, dass auch mit Minuten gerechnet werden kann. Allerdings scheint es ein Problem zu geben. Wenn ich hinzufüge
960 Minuten bis 22-05-15 16:00 die Funktion gibt ein korrektes Ergebnis von 26-05-15 14:00
Bei einer zusätzlichen Stunde (60 Min.) ändert sich das Ergebnis jedoch wieder auf 25.05.15, 09:00 Uhr.
Sieht hier jemand das Problem?
Option Explicit
Public Function EndDayTimeM(StartTime As String, Minutes As Double)
On Error GoTo Hell
' start and end hour are fixed here.
' could put them in cells and look them up
Dim startMinute As Long, endMinute As Long, startHour As Long, endHour As Long
startMinute = 480
endMinute = 960 ' was 18
startHour = 8
endHour = 16
Dim calcEnd As Date, start As Date
start = CDate(StartTime)
calcEnd = DateAdd("n", Minutes, start)
If DatePart("h", calcEnd) > endHour Or DatePart("h", calcEnd) <= startHour Then
' add 15 hours to get from 17+x to 8+x
calcEnd = DateAdd("h", 15, calcEnd) ' corrected
End If
If DatePart("w", calcEnd) = 7 Or DatePart("w", calcEnd) = 1 Then
' Sat or Sun: add 2 days
calcEnd = DateAdd("d", 2, calcEnd)
End If
If DatePart("h", calcEnd) > endHour Or DatePart("h", calcEnd) <= startHour Then
' add 15 hours to get from 17+x to 8+x
calcEnd = DateAdd("h", 15, calcEnd) ' corrected
End If
EndDayTimeM = calcEnd
Antwort1
Das Folgende erledigt das, was Sie möchten, und ist vollständig konfigurierbar. Darüber hinaus unterstützt es jedes Eingabe- oder Ausgabeformat, solange Excel es noch als numerisches Datum+Uhrzeit versteht. Sie können für Ihre Arbeitszeiten/-tage einen beliebigen Anfang oder ein beliebiges Ende festlegen.
Public Function EndDayTimeM(StartTime As Double, Minutes As Long)
Dim rangeH, numH, rangeD, numD, startD, durW, durD, durH, durM, startW, endW, remTime As Long
Dim startH, endDate As Double
rangeH = 8 ' Starting hour of working day
numH = 9 ' Length of working day in hours
rangeD = 2 ' Starting day of working week
numD = 5 ' Length of working week in days
' Calculates offset from 00:00 Monday in starting week
startW = Fix(StartTime) - DatePart("w", StartTime)
startD = DatePart("w", StartTime) - rangeD
startH = (StartTime - Fix(StartTime)) * 24
' Calculates end time in working weeks, hours, minutes
remTime = Minutes + (startD * numH * 60) + ((startH - rangeH) * 60)
durW = Fix(remTime / 60 / numH / numD)
remTime = remTime - (durW * numD * numH * 60)
durD = Fix(remTime / 60 / numH)
remTime = remTime - durD * 60 * numH
durH = Fix(remTime / 60)
remTime = remTime - durH * 60
durM = remTime
' Converts working weeks into calendar weeks
endDate = startW + durW * 7 + rangeD + durD + (rangeH + durH) / 24 + durM / 1440
EndDayTimeM = endDate
End Function
Antwort2
Mit so etwas wären Sie besser dran -
Public Function EndDayTimeM(StartTime As String, Minutes As Double)
Dim begintime As Date
begintime = CDate(starttime)
Dim startminutes As Double
startminutes = Hour(starttime) * 60 + Minute(starttime)
Dim x As Integer
x = startminutes + minutes
Dim endtime As Date
If x < 1020 Then
endtime = DateAdd("n", minutes, begintime)
MsgBox (endtime)
End If
If x > 1020 Then
If Weekday(begintime, vbMonday) = 5 Then
endtime = DateAdd("y", 3, begintime)
Else: endtime = DateAdd("y", 1, endtime)
End If
endtime = DateAdd("n", minutes, endtime)
endtime = DateAdd("n", -480, endtime)
MsgBox (endtime)
End If
End function
Antwort3
Worüber ich in meiner vorherigen Antwort gesprochen habe, die in der Praxis abgelehnt wurde:
Public Function EndDayTimeM(StartTime As String, Minutes As Double)
Dim start As Date, starthour As Date, endhour As Date, minutes2 As Date
start = CDate(StartTime)
minutes2 = DateAdd("n", Minutes, 0)
starthour = 8 / 24 'working day starts at 8
endhour = 16 / 24 'working day ends at 16, wasn't it 17?
While minutes2 > 0 'while we have time remaining
If Weekday(start, vbMonday) < 6 Then 'if it's a weekday
EndDayTimeM = start + minutes2 'it ends at the date (soonest possible)
minutes2 = start + minutes2 - CDate(Int(start) + endhour) 'the remaining minutes as a difference between the sum of start and norm minus the end of the day
start = Int(start) + 1 + starthour 'next start is tomorrow's starting
Else
start = start + 1 'if weekend, skip a day
End If
Wend
End Function