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

“输入”和“输出”列分别包含一个日期和一个小时。我需要做的是查看“输入”和“输出”中的小时和分钟，并计算它们之间的小时和分钟。像第二张表一样，每个计算的小时和分钟必须保存在一行中。使用上面的代码，我只能提取小时，例如23.03.2018 09：00：00、10：00：00、11：00：00等。我知道如何更改函数“ GetHour”以节省分钟吗？谢谢！

Answer 1

您可以完全取消函数调用，只需使用DateDiff来计算每个条目之间的分钟数，然后使用For-Next循环将迭代中的分钟数迭代添加到{{ 1}}

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

VBA：在2列之间提取分钟和小时

1 个答案: