☰

根據工作時間計算結束時間並跳過週末

tag-icon • tag-icon microsoft-excel worksheet-function vba
根據工作時間計算結束時間並跳過週末

在我的工作表中，我想計算流程的估計結束時間。

但是，我想將其限制在預定的時間限制內。例如，當我將 4 小時添加到 14:00 時，我不希望結果是 18:00，而是 9:00！

假設工作日為 8:00 - 17:00。並且省略星期六和星期日

誰能幫我嗎？

在 rcl 的 Simon 的幫助下，我成功地調整了他的解決方案，使其能夠以分鐘為單位進行計算。然而，似乎有一個問題。當我添加

960 分鐘到 22-05-15 16:00 此函數給出的正確結果為 26-05-15 14:00

但是，多一小時（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

相關內容