Как рассчитать расчетные моменты с 8 часовыми рабочими днями

Question

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

Предположим, рабочие дни с 8:00 до 17:00 и пропускаем субботу и воскресенье.

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

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

РЕДАКТИРОВАТЬ -

С помощью Саймона в 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

GoTo Ret

Hell:
EndDayTimeM = Err.Description
Ret:

End Function

Answer 1

В Excel перейдите на вкладку Лента разработчиков и щелкните Visual Basic.

Щелкните правой кнопкой мыши по проекту VBA (выделено красным) и выберите «Вставить», а затем «Модуль». Это добавит Module1 в проект под VBAProject. Дважды щелкните на Module1.

Выберите панель справа и вставьте следующий код в:

Option Explicit

Public Function EndDayTime(StartTime As String, Hours As Double)

    On Error GoTo Hell
    ' start and end hour are fixed here. 
    ' could put them in cells and look them up
    Dim startHour As Long, endHour As Long
    startHour = 8

    endHour = 17 ' was 18

    Dim calcEnd As Date, start As Date
    start = CDate(StartTime)
    calcEnd = DateAdd("h", Hours, 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

    EndDayTime = calcEnd

    GoTo Ret

Hell:
    EndDayTime = Err.Description
Ret:

End Function

Затем вы можете использовать его в своем рабочем листе следующим образом: В этом примере у меня есть DateTime, который я ввел в A2, количество часов в B2 ...B8, а столбец C имеет функцию EndDayTime с использованием Ax и Bx. В столбце A после строки 2 он просто копирует C [row - 1], поэтому предыдущий конец становится следующим.

Ура -

РЕДАКТИРОВАТЬ: Исправлен код для времени окончания 17, а не 18.