VBA: извлекать минуты и часы между 2 столбцами

Question

У меня есть следующий список:

ID  In                        Out 
A   23.03.2018  08:16:14      23.03.2018  13:56:03
B   23.03.2018  11:16:14      23.03.2018  13:56:03

Я должен создать что-то вроде этого:

ID  In                         
A   23.03.2018  08:17:00      
A   23.03.2018  08:18:00
...
A   23.03.2018  13:55:00      
B   23.03.2018  11:17:00
B   23.03.2018  11:18:00
...
B   23.03.2018  13:55:00      

Чтобы сделать это, я попытался с этим кодом

Sub TimeSheet()
Dim timeEntries As Range, entry As Range, startTime As Integer, endTime As Integer, hr As Integer, lastRow As Integer

Set timeEntries = Worksheets("Input").Range("A2:A3")

For Each entry In timeEntries
    startTime = GetHour(entry.Offset(0, 1), "IN")
    endTime = GetHour(entry.Offset(0, 2), "OUT")

    For hr = startTime To endTime

        With Worksheets("Output")
            lastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
            .Range("A" & lastRow) = entry
            .Range("B" & lastRow) = DateValue(entry.Offset(0, 1)) & " " & TimeSerial(hr, 0, 0)
        End With

    Next hr
Next entry

End Sub

Function GetHour(t As Date, stamp As String) As Date
Dim result As Date

If stamp = "IN" Then
    If Minute(t) = 0 Then
        result = Hour(t)
    Else
        result = Hour(DateAdd("h", 1, t))
    End If
Else
    If Minute(t) = 0 Then
        result = Hour(t)
    Else
        result = Hour(DateAdd("h", -1, t))
    End If

End If

GetHour = result
End Function

В столбцах «Вход» и «Выход» содержатся каждая дата и час.Что мне нужно сделать, так это посмотреть на часы и минуты с «In» и «Out» и посчитать часы и минуты между ними.Каждый отсчитанный час и минуту должны быть сохранены в строке, как во второй таблице.С помощью приведенного выше кода я могу извлечь только часы, например, 23.03.2018, 09:00:00, 10:00:00, 11:00:00 и т. Д. Есть идеи, как изменить функцию «GetHour», чтобы также сэкономить минуты?Спасибо!

Answer 1

Вы можете полностью отказаться от вызова функции и просто использовать DateDiff для вычисления количества минут между каждой записью, используя цикл For-Next для итеративного добавления минуты в итерации к startTime

Option Explicit
Sub TimeSheet()
    Dim timeEntries As Range
    Dim entry As Range
    Dim startTime As Date
    Dim endTime As Date
    Dim lastRow As Long
    Dim minutes As Long
    Dim m As Long

    Set timeEntries = Worksheets("Input").Range("A2:A3")

    For Each entry In timeEntries
        startTime = entry.Offset(0, 1)
        endTime = entry.Offset(0, 2)

        minutes = DateDiff("n", startTime, endTime)
        With Worksheets("Output")
            For m = 1 To minutes - 1
                lastRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
                .Range("A" & lastRow) = entry
                .Range("B" & lastRow) = Format(startTime + (m / 1440), "dd.mm.yyyy hh:mm:00")
            Next m
        End With
    Next entry
End Sub

Полученные результаты:

A   23.03.2018 08:17:00
A   23.03.2018 08:18:00
A   23.03.2018 08:19:00
A   23.03.2018 08:20:00
....
A   23.03.2018 13:55:00
B   23.03.2018 11:17:00
B   23.03.2018 11:18:00
B   23.03.2018 11:19:00
B   23.03.2018 11:20:00
....
B   23.03.2018 13:55:00