持续时间超过 24 小时

Question

我的代码运行完美，但是当增加持续时间超过 24 小时时，代码返回第二天的时间。请看图片：

例如：

CELL(C3)-0500_1145-DURATION IS 6.45

CELL(D3)-CTC-THE CODE WILL IGNORE AND MOVE TO NEXT CELL

CELL(E3)-0500_1145-DURATION IS 6.45

CELL(F3)-0500_1145-DURATION IS 6.45----TOTAL 

DURATION=6.45(C3)+6.45(E3)+6.45(F3)=20.15

CELL(G3) & CELL(I3)-OFF -THE CODE WILL IGNORE AND MOVE TO NEXT CELL

CELL(H3)-1000_1800(ACP)-DURATION IS 8

虽然代码在这里计算持续时间，即 8 小时，但是当系统将所有持续时间相加时，它应该给出 28:15，但系统将其作为第二天并返回总持续时间为 4:15。 我的问题是，当持续时间超过 24 小时时，如何让系统返回 4:15 的 28 小时 15 分钟（28:15）iso。

Sub CalculateHourly()

Dim j As Long
Dim TextTime, wStart, wStop, midnight As String
Dim TrueTime, Temp As Date
Dim Parts As Variant
Dim lRow As Long
Application.Calculation = xlManual

midnight = "24" & ":" & "00"
 'Find the last non-blank cell in column A(1)
lRow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To lRow
For j = 3 To 9

    TextTime = ""
    'copy content of the cells
    TextTime = ThisWorkbook.Application.Sheets("Sheet1").Cells(i, j).Value
     'loop only of cell does not contain any text
    If InStr(1, TextTime, "CTC", vbTextCompare) = 0 And InStr(1, TextTime, "OFF", vbTextCompare) = 0 And InStr(1, TextTime, "LEAVE", vbTextCompare) = 0 _
     And Not IsEmpty(TextTime) Then
     
        Parts = Split(TextTime, "_")
        
        'Left(Parts(0), 2) of 0430-04
        'Right(Parts(0), 2) of 0430-30
        wStart = Left(Parts(0), 2) & ":" & Right(Parts(0), 2)
        'wStop = Left(Parts(1), 2) & ":" & Right(Parts(1), 2)
         wStop = Left(Parts(1), 2) & ":" & Mid(Parts(1), 3, 2)
        
        
        Debug.Print ("test : " & Format(wStart, "h:mm;@"))
        'If timeout is less than timein
        If wStart > wStop Then
        'Add 24 hours and make the diff
        TrueTime = 24 + CDate(CDate(CDate(Format(wStop, "h:mm;@")) - CDate(Format(wStart, "h:mm;@"))))
        
        Else
        'if timeout greater than timein
        TrueTime = CDate(CDate(CDate(Format(wStop, "h:mm;@")) - CDate(Format(wStart, "h:mm;@"))))
        
        End If
        
        **If (Temp + TrueTime) > 24 Then
        TrueTime = 24 + Temp + TrueTime**
        Else
        TrueTime = Temp + TrueTime
        End If
        
        
        Temp = TrueTime
    
    End If
    
Next j 'move to the number column in the same row

Cells(i, 10).Value = CDate(Format(Temp, "h:mm;@"))
Temp = Temp - Temp
Next i 'move to the next row

End Sub

Answer 1

使用这样的函数将格式设置为小时：分钟：

Public Function FormatHourMinute( _
  ByVal datTime As Date, _
  Optional ByVal strSeparator As String = ":") _
  As String

' Returns count of days, hours and minutes of datTime
' converted to hours and minutes as a formatted string
' with an optional choice of time separator.
'
' Example:
'   datTime: #10:03# + #20:01#
'   returns: 30:04
'
' 2005-02-05. Cactus Data ApS, CPH.

  Dim strHour       As String
  Dim strMinute     As String
  Dim strHourMinute As String

  strHour = CStr(Fix(datTime) * 24 + Hour(datTime))
  ' Add leading zero to minute count when needed.
  strMinute = Right("0" & CStr(Minute(datTime)), 2)
  strHourMinute = strHour & strSeparator & strMinute

  FormatHourMinute = strHourMinute

End Function

Answer 2

Sub CalculateHourly2()

    Dim j As Long
    Dim TextTime As String, wStart As Date, wStop As Date, midnight As String
    Dim Parts As Variant
    Dim lRow As Long
    Dim vArray() As Variant, n As Integer
    Application.Calculation = xlManual
    
     'Find the last non-blank cell in column A(1)
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 3 To lRow
        n = 0
        For j = 3 To 9
            TextTime = ""
            'copy content of the cells
            TextTime = ThisWorkbook.Application.Sheets("Sheet1").Cells(i, j).Value
             'loop only of cell does not contain any text
            If InStr(1, TextTime, "CTC", vbTextCompare) = 0 And InStr(1, TextTime, "OFF", vbTextCompare) = 0 And InStr(1, TextTime, "LEAVE", vbTextCompare) = 0 _
             And TextTime <> "" Then '<~~ Unlike the case where the cell is empty, if you put an empty cell into a variable, it is not empty.
                Parts = Split(TextTime, "_")
                'Left(Parts(0), 2) of 0430-04
                'Right(Parts(0), 2) of 0430-30
                wStart = TimeValue(Left(Parts(0), 2) & ":" & Right(Parts(0), 2))
                'wStop = TimeValue(Left(Parts(1), 2) & ":" & Right(Parts(1), 2))
                 wStop = Left(Parts(1), 2) & ":" & Mid(Parts(1), 3, 2) '<~~  Since other characters have been added, the mid sentence must be used.
                n = n + 2
                ReDim Preserve vArray(1 To n)
                vArray(n - 1) = wStart
                vArray(n) = wStop
            End If
            
        Next j 'move to the number column in the same row
    
        'Cells(i, 10).Value = CDate(Format(Temp, "h:mm;@"))
        If n > 0 Then
            Cells(i, 10).Value = getTime(vArray)
            Cells(i, 10).NumberFormat = "[hh]:mm"
        End If
    Next i 'move to the next row

End Sub

Function getTime(Other() As Variant)
    Dim myTime As Date, s As Date, e As Date
    Dim i As Integer

    For i = LBound(Other) To UBound(Other) Step 2
        s = Other(i)
        e = Other(i + 1)
        If s > e Then
            e = e + 1
        End If
        myTime = myTime + e - s
    Next i
    getTime = myTime
End Function

图纸图片