Question

我是VBA的新手，遇到了一个问题我的目标是找到一种评估负时间值的优雅方法。

例如，下面的代码主体会生成一个显示12:30:00 AM的消息框。我希望它能显示11:30:00 PM。

Sub Main() 'Run Test
Dim difference As Date
    difference = #12:00:00 AM# - #12:30:00 AM#
    MsgBox difference
End Sub

我已经为这个问题创建了一个解决方案，但是想知道编码社区的反馈有些代码不是必需的，但我已将其编写为可能在将来很重要的功能。

run子例程允许您使用指定的值运行test函数 test函数测试timeDiff＆amp; timeSum逻辑 timeDiff函数查找t1和t0之间的时差 timeSum函数查找t1和t0的时间总和 asDuration函数从时间值中删除AM / PM后缀 asMilitary函数将12小时格式转换为24小时格式我创建的concat函数更容易连接字符串。

Sub Main() 'Run Test
    MsgBox Test("0:29:0", "23:30:0")
End Sub


Function Test(startT As Date, endT As Date) 'Test timeDiff & timeSum logic
    Dim nextShift As Date, prevShift As Date, hours As Date

    hours = timeDiff(endT, startT)
    prevShift = timeDiff(startT, "0:30:0")
    nextShift = timeSum("0:30:0", endT)        

    Test = concat("Start -", startT, "", "End - ", endT, "", "Duration -", asDuration(hours), "", "Next Shift: ", nextShift, "", "Prev Shift: ", prevShift)
End Function


Function timeDiff(t1 As Date, t0 As Date) As Date 'Return Time1 minus Time0
    Dim units(0 To 2) As String

    units(0) = Hour(t1) - Hour(t0)
    units(1) = Minute(t1) - Minute(t0)
    units(2) = Second(t1) - Second(t0)

    If units(2) < 0 Then
        units(2) = units(2) + 60
        units(1) = units(1) - 1
    End If

    If units(1) < 0 Then
        units(1) = units(1) + 60
        units(0) = units(0) - 1
    End If

    units(0) = IIf(units(0) < 0, units(0) + 24, units(0))
    timeDiff = Join(units, ":")
End Function


Function timeSum(t1 As Date, t0 As Date) As Date 'Return Time1 plus Time0
    Dim units(0 To 2) As String

    units(0) = Hour(t1) + Hour(t0)
    units(1) = Minute(t1) + Minute(t0)
    units(2) = Second(t1) + Second(t0)

    If units(2) >= 60 Then
        units(2) = units(2) Mod 60
        units(1) = units(1) + 1
    End If

    If units(1) >= 60 Then
        units(1) = units(1) Mod 60
        units(0) = units(0) + 1
    End If

    units(0) = IIf(units(0) >= 24, units(0) Mod 24, units(0))
    timeSum = Join(units, ":")
End Function


Function asDuration(time As Date) As String 'Display as duration; Remove AM/PM suffix from time
    time = asMilitary(time)
    asDuration = Left(time, Len(time))
End Function


Function asMilitary(time As Date) As String 'Convert 12-hour format to 24-hour-format
    asMilitary = Hour(time) & ":" & Minute(time) & ":" & Second(time)
End Function


Function concat(ParamArray var() As Variant) As String 'Return arguments of function call concatenated as a single string
    For Each elem In var()
        concat = IIf(elem <> "", concat & elem & " ", concat & vbNewLine)
    Next
End Function

Answer 1

事实证明它比我最初的测试有点棘手。只需输入VBA编辑器的即时窗口，我就可以手动编写几个项目，编辑＆＃34;智能地纠正＆＃34;为了我。但在任何情况下，底层解决方案都保持不变。

关键是＆＃34;锚定＆＃34;您在某个日期的时间价值 - 任何日期都可以，因为它会在以后减去。但这会使你的数学运算符合预期。

Option Explicit

Sub test()
    Debug.Print TimeDiff("12:00:00", "00:30:00")
    Debug.Print TimeDiff("0:29:0", "23:30:0")
    Debug.Print TimeDiff("16:00:00", "4:30:00")
End Sub

Function TimeDiff(t1 As Date, t0 As Date) As Date
    '--- returns t1-t0

    Dim d1 As Date
    Dim dayAnchor As Date

    dayAnchor = #1/1/2015#
    d1 = dayAnchor + t1
    TimeDiff = (d1 - t0) - dayAnchor
End Function

Answer 2

Option Compare Database
Sub Main() 'Run Test
    MsgBox Test("00:29:00", "23:30:00")
End Sub

Function Test(startT As Date, endT As Date) 'Test timeDiff logic
    Dim nextShift As Date, prevShift As Date, hours As Date

    hours = timeDiff(endT, startT)
    prevShift = timeDiff(startT, "0:30:0")
    nextShift = timeDiff("0:30:0", endT)

    Test = concat("Start -", startT, "", "End - ", endT, "", "Duration -", asDuration(hours), "", "Next Shift: ", nextShift, "", "Prev Shift: ", prevShift)
End Function


Function timeDiff(t1 As Date, t0 As Date) As Date 'Returns t1-t0
    dayAnchor = #1/1/2015#
    timeDiff = ((dayAnchor + TimeValue(t1)) - TimeValue(t0)) - dayAnchor
End Function

Function asDuration(time As Date) As String 'Display as duration; Remove AM/PM suffix from time
    t = Hour(time) & ":" & Minute(time) & ":" & Second(time)
    asDuration = Left(t, Len(t))
End Function

Function concat(ParamArray var() As Variant) As String 'Return arguments of function call concatenated as a single string
    For Each elem In var()
        concat = IIf(elem <> "", concat & elem & " ", concat & vbNewLine)
    Next
End Function

计算机与计算机评估VBA中的负时间值

2 个答案: