Попытка получить разницу между 2 датами (3 разных ячейки)

Question

Не могли бы вы помочь мне получить разницу между двумя датами (только рабочее время, это очень важно)

Посмотрите на это изображение:

Первый ответ рассчитывается по разнице между: Дата первого ответа и Дата проблемы

Истекшее время рассчитывается по разнице между: Дата последнего ответа и Дата проблемы

Пока это мой макрос (он не работает должным образом):

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const WORKING_DAY_START As String = "09:00"
Const WORKING_DAY_END As String = "18:00"
Const FORMULA_WORKING_TIME As String = _
    "=(INT(E2-D2)*(""" & WORKING_DAY_END & """-""" & WORKING_DAY_START & """)" & _
    "+MEDIAN(MOD(E2,1),""" & WORKING_DAY_END & """,""" & WORKING_DAY_START & """)" & _
    "-MEDIAN(MOD(D2,1),""" & WORKING_DAY_END & """,""" & WORKING_DAY_START & """))"
Const FORMULA_ELAPSED_TIME As String = "=F2-D2"
Dim lastrow As Long

    On Error GoTo ws_bdc_exit

    Application.ScreenUpdating = False
    Application.EnableEvents = False

    With Me

        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        'input Elapsed Time
        .Range("H2").Resize(lastrow - 1).Formula = FORMULA_ELAPSED_TIME

        'input First Response time
        .Range("G2").Resize(lastrow - 1).Formula = FORMULA_WORKING_TIME

        With .Range("G2:H2").Resize(lastrow - 1)
            .Value = .Value
            .NumberFormat = "##0.00"
        End With
    End With

ws_bdc_exit:
    Target.Offset(1).Select

    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

РЕДАКТИРОВАТЬ # 1: я должен получить рабочее время с понедельника по пятницу (выходные не включены, но я не знаю, как это сделать)

РЕДАКТИРОВАТЬ # 2: Разница должна отображаться в часов

РЕДАКТИРОВАТЬ # 3: Раньше я использовал этот макрос (все работало нормально, НО я не получал рабочее время)

Public cVal
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim LastRow
LastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
t1 = TimeValue(CStr(Cells(i, "D").Value))
t2 = TimeValue(CStr(Cells(i, "E").Value))
t3 = TimeValue(CStr(Cells(i, "F").Value))

'input First Response time
If Hour(t2) - Hour(t1) = 0 Then
    Cells(i, "G").Value = Round((Minute(t2) - Minute(t1)) / 60, 2)
Else
    Cells(i, "G").Value = Hour(t2) - Hour(t1) + Round((Minute(t2) - Minute(t1)) / 60, 2)
End If

'input Elapsed Time
If Hour(t3) - Hour(t1) = 0 Then
    Cells(i, "H").Value = Round((Minute(t3) - Minute(t1)) / 60, 2) '- Cells(i, "J").Value - Cells(i, "J").Value
Else
    Cells(i, "H").Value = Hour(t3) - Hour(t1) + Round((Minute(t3) - Minute(t1)) / 60, 2) '- Cells(i, "J").Value
End If
Next i

Target.Offset(1).Select
End Sub

Answer 1

Возможно, нет необходимости использовать VBA.

1. Используйте функцию NETWORKDAYS для подсчета рабочих дней между датами.

2. Умножьте их на рабочие часы в день

3. Вычитание рабочего времени из даты начала и окончания (например, работа началась позже, чем рабочий день и т. Д.)

4. Рассчитать итоги.

Я бы порекомендовал сделать каждый шаг в одной ячейке, чтобы проверить пошаговую логику.

Answer 2

Я написал функцию, которая должна вычислять рабочее время, только с понедельника по пятницу.

Обратите внимание, что в вашем опубликованном примере некоторые даты указаны в субботу / воскресенье, поэтому рассчитывается как ноль.

Алгоритм:

• Рассчитать рабочие часы для каждого дня с понедельника по пятницу как WORKING_DAY_START - WORKING_DAY_END` часов.
• Выполните корректировку, если день считается первым или последним вычисляемым днем.

Вы можете использовать эту функцию либо на самом листе, либо вызывать его из макроса, который заполняет ячейки только значением.

Ниже я покажу ваши исходные данные, а также некоторые дополнительные строки, изменяющие даты ваших выходных.

Option Explicit
Function elapsedWorkTime(startDT As Date, endDt As Date) As Date
    Const WORKING_DAY_START As Date = #9:00:00 AM#
    Const WORKING_DAY_END As Date = #6:00:00 PM#
    Dim adjTimeStart As Date, adjTimeEnd As Date, totTime As Date
    Dim D As Date

For D = DateValue(startDT) To DateValue(endDt)
    Select Case Weekday(D)
        Case 2 To 6
            'Adj for first and last days
            If D = DateValue(startDT) Then
                If TimeValue(startDT) <= WORKING_DAY_START Then
                    adjTimeStart = 0
                ElseIf TimeValue(startDT) >= WORKING_DAY_END Then
                    adjTimeStart = WORKING_DAY_START - WORKING_DAY_END
                Else
                    adjTimeStart = WORKING_DAY_START - TimeValue(startDT)
                End If
            End If

            If D = DateValue(endDt) Then
                If TimeValue(endDt) >= WORKING_DAY_END Then
                    adjTimeEnd = 0
                ElseIf TimeValue(endDt) <= WORKING_DAY_START Then
                    adjTimeEnd = WORKING_DAY_START - WORKING_DAY_END
                Else
                    adjTimeEnd = TimeValue(endDt) - WORKING_DAY_END
                End If
            End If

            totTime = totTime + WORKING_DAY_END - WORKING_DAY_START
    End Select
Next D

elapsedWorkTime = totTime + adjTimeStart + adjTimeEnd

End Function

РЕДАКТИРОВАТЬ Исправлено форматирование на скриншоте

Обратите внимание, что формула в ячейке рабочего листа, поскольку вы хотите, чтобы выходные данные выражались в часах, выглядит примерно так:

=elapsedWorkTime(C2;D2)*24

Обратите внимание на расхождение для 5541. В вашем примере вы показываете значение 8,52 за прошедшее время. Но в своем заявлении о требованиях вы пишете, что хотите указать только рабочее время. Рабочее время заканчивается в 18:00, поэтому время, проведенное после этого, не должно учитываться.