Разница во времени для преобразования чч / мм / сс

Question

У меня есть код, который преобразует разницу во времени в любой данный день в ЧЧ ММ СС.

Sub timefind()

Dim eDate As Date

Dim StartDate As Date

Dim mHours As Long, mMinutes As Long, mSeconds As Double

'Dim iValue As Variant

Dim wb1 As Workbook

Dim ws1 As Worksheet

Dim ws2 As Worksheet

Dim ws1lastrow As Double

Dim tymval As Double

Set wb1 = Workbooks("Time_Comparison.xlsm")

Set ws1 = wb1.Worksheets("Input")

Set ws2 = wb1.Worksheets("Dashboard")

Range("A1").EntireRow.Insert

ws1.Cells(1, 1).Value = "Date"
ws1.Cells(1, 2).Value = "Time"
ws1.Cells(1, 3).Value = "Hours"
ws1.Cells(1, 4).Value = "Minutes"
ws1.Cells(1, 5).Value = "Seconds"

ws1lastrow = ws1.Cells(Rows.Count, 1).End(xlUp).Row

StartDate = ws1.Cells(2, 2).Value

For tymval = 2 To ws1lastrow

    Set curCell = ws1.Cells(tymval, 1)

    Set nextCell = ws1.Cells(tymval, 1).Offset(1, 0)

    If nextCell.Value <> curCell.Value Then

    eDate = ws1.Cells(tymval, 1).Offset(0, 1)
    'to hours
    ws1.Cells(tymval, 3) = DateDiff("s", StartDate, eDate) / (60 * 60)
    ws1.Cells(tymval, 3) = Int(ws1.Cells(tymval, 3))

    'to Minutes
    ws1.Cells(tymval, 4) = DateDiff("s", StartDate, eDate) / 60 - ws1.Cells(tymval, 3) * 60
    ws1.Cells(tymval, 4) = Int(ws1.Cells(tymval, 4))

    'to seconds
    ws1.Cells(tymval, 5) = DateDiff("s", StartDate, eDate) / 60 - ws1.Cells(tymval, 3) * 60 - ws1.Cells(tymval, 4)
    ws1.Cells(tymval, 5) = ws1.Cells(tymval, 5) * 60

    StartDate = ws1.Cells(tymval, 1).Offset(1, 1)

End If

Next

End Sub

Теперь новое требование: если минуты <= 30, то минуты следует учитывать как 30 минут, а если минут> 30, это следует считать 60 минутами и прибавлять к часу. Как это сделать.

Если nextCell.Value <> curCell.Value Then

eDate = ws1.Cells(tymval, 1).Offset(0, 1)

ws1.Cells(tymval, 3) = DateDiff("s", StartDate, eDate) / (60 * 60)
ws1.Cells(tymval, 3) = Int(ws1.Cells(tymval, 3))

ws1.Cells(tymval, 4) = DateDiff("s", StartDate, eDate) / 60 - ws1.Cells(tymval, 3) * 60
ws1.Cells(tymval, 4) = Int(ws1.Cells(tymval, 4))

If ws1.Cells(tymval, 4).Value <= "30" Then
ws1.Cells(tymval, 4).Value = "30"
ws1.Cells(tymval, 4) = Int(ws1.Cells(tymval, 4))

ElseIf ws1.Cells(tymval, 4).Value > "30" Then
ws1.Cells(tymval, 4).Value = "00"
ws1.Cells(tymval, 3) = ws1.Cells(tymval, 3) + 1
ws1.Cells(tymval, 3) = Int(ws1.Cells(tymval, 3))

End If

ws1.Cells(tymval, 5) = DateDiff("s", StartDate, eDate) / 60 - ws1.Cells(tymval, 3) * 60 - ws1.Cells(tymval, 4)
ws1.Cells(tymval, 5) = ws1.Cells(tymval, 5) * 60

ws1.Cells(tymval, 6) = DateDiff("s", StartDate, eDate)

StartDate = ws1.Cells(tymval, 1).Offset(1, 1)

Answer 1

Вот UDF, который я использовал для тестирования. Его будет легко интегрировать в ваш код, как только он будет усовершенствован.

Function TryDate(Sdate As Date, Edate As Date) As Double

    Dim Fun As Double

    Fun = (Edate - Sdate) * 24
    If Fun - Int(Fun) > 0.5000001 Then Fun = Int(-Fun) * -1
    TryDate = Fun * 60
End Function

Вызовите его из таблицы, например =TryDate(A2, A3), где A2 имеет время начала в формате даты / времени, а A3 - время окончания.

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

Function TryDate(Sdate As Date, Edate As Date) As Double

    Dim Fun As Double

    Fun = (Edate - Sdate) * 24

    If Fun - Int(Fun) > 0.5000001 Then
        Fun = Int(-Fun) * -60
    Else
        Fun = Int(Fun * 60 * 60)
    End If
    TryDate = Fun
End Function

Обратите внимание, что значение 0,0000001, добавляемое к 0,5, является значением меньше секунды, что необходимо, поскольку VBA не будет интерпретировать 30 минут как 0,5 часа. Добавление гарантирует, что 30 минут не будут округлены.

Answer 2

Я бы попробовал что-то в этом духе

Function RoundUpTime(t As Date) As Date

If Minute(t) < 30 Then
    RoundUpTime = TimeSerial(Hour(t), 30, 0)
ElseIf Minute(t) > 30 Then
    RoundUpTime = TimeSerial(Hour(t) + 1, 0, 0)
End If

End Function