☰

расчет времени окончания с учетом рабочего времени и без учета выходных

tag-icon • tag-icon microsoft-excel worksheet-function vba
расчет времени окончания с учетом рабочего времени и без учета выходных

В своей рабочей таблице я хочу рассчитать предполагаемое время окончания процессов.

Однако я хочу ограничить это предопределенным временным ограничением. Так, например, когда я добавляю 4 часа к 14:00, я не хочу, чтобы результат был 18:00, а 9:00!

Предполагая рабочие дни с 8:00 до 17:00. И исключая субботу и воскресенье.

Может кто-нибудь мне помочь?

С помощью Саймона из rcl мне удалось адаптировать его решение для расчета с минутами. Однако, похоже, есть проблема. Когда я добавляю

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

Связанный контент