ワークシートで、プロセスの推定終了時間を計算したいと考えています。
ただし、これを事前に決められた時間制約に制限したいのです。たとえば、14:00 に 4 時間を追加した場合、結果は 18:00 ではなく 9:00 になるようにしたいのです。
平日は8:00~17:00と仮定。土曜・日曜は除く
誰か助けてくれませんか?
rclのSimonの助けを借りて、私は彼のソリューションを分単位で計算するように適応させることができました。しかし、問題があるようです。
22-05-15 16:00までの960分で、関数は26-05-15 14:00という正しい結果を返します。
ただし、さらに 1 時間 (60 分) 経過すると、結果は 25-05-15 09:00 に戻ります。
誰かここに問題があるのか?
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
答え1
以下は、必要なことを実行し、完全に構成可能です。さらに、Excel が数値の日付と時刻として認識できる限り、任意の入力形式または出力形式をサポートします。勤務時間/勤務日の開始または終了を任意に設定できます。
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
答え2
次のような方が良いでしょう -
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
答え3
前回の回答で私が話していた内容は、実際には次のとおりです。
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