应用程序/日期之间的时间差

摘要

此模块包含用于计算两个完整表达日期之间的时间差的 VBA 代码；即包含日期和时间信息。它可以在任何可以运行 VBA 代码的 MS Office 应用程序（如 Excel）中运行。

此过程显示如何从日期变量中提取时间组件的整数，而不是更常见的日期字符串表示。也就是说，假设两个日期之间的差值为两天，则提取整数2而不是年份1900的某个日期字符串。
日期变量包含日期和时间的组合，但它们并不一定如此。有些只包含日期，有些只包含时间，当转换为单精度数据类型时，它们可以被视为在它们的整数部分表示天，在它们的小数部分表示时间。虽然输入参数可以包含任何日期变量，但只有当每个参数都包含时间和日期时才能获得精确结果。如果日期缺少时间数据，则仍会执行计算，但会使用午夜作为假设。
日期转换为单精度的整数部分只是自1899 年 12 月 31 日以来的天数。因此，负整数部分描述了该参考日期之前的日期。实际上，日期函数可用于公元历中从718 年 8 月 2 日到9999 年 12 月 31 日的日期，尽管这在使用其他日历时会有所不同。向日期变量添加整数或从日期变量中减去整数以根据该天数修改日期。减法也适用。
日期的小数部分表示一天的一部分。可以在其中获得时间的各个部分，如下所示；将日期变量乘以 86400 以找到总秒数；乘以1440 以找到总分钟数；并乘以24 以找到总小时数。然后将这些结果转换为单精度数据类型，然后再取每个整数部分。为了修改现有日期变量的秒数，我们只需为每秒添加1/86400；每分钟1/1440，每小时1/24，如前所述，天数为整个单位。减法也适用。
还存在各种函数来简化日期时间处理.

代码模块

将以下所有 VBA 代码复制到标准模块中。

运行顶部过程以测试该函数。给出了两个示例；一个用于精确的日期时间数据，另一个用于缺少某些时间数据的情况。
输出结果是一个冒号分隔的字符串，包含一系列格式中的任何一个；仅秒数、分钟-秒数、小时-分钟-秒数或天数-小时-分钟-秒数。格式选项由sConfig设置，可选单位标签在sLabel中返回。
该过程的细节很有用。过程LapsedTime()说明了多组件提取的基本原理，与使用 VBA DateDiff 函数的单类型计数间隔相比。

Option Explicit

Sub testLapsedTime()
    'Run this to test LapsedTime()
    'For both fully expressed and
    'partially expressed date-times
    
    Dim dDateTimeStart As Date
    Dim dDateTimeEnd As Date
    Dim sOut As String, sLab As String

'EXACT LAPSED TIME FOR TWO DATE-TIME VALUES
    
    'set two exact date-times for calculation
    dDateTimeStart = #1/5/2019 1:20:10 PM# '
    dDateTimeEnd = #1/7/2019 2:37:20 PM#
    
    'exactly 2 days, 1 hours, 17 mins, and 10 seconds apart
    sOut = LapsedTime(dDateTimeEnd, dDateTimeStart, "dhms", sLab)
    MsgBox "Exact Lapsed Time:" & vbCrLf & "For fully expressed date-times:" & vbCrLf & vbCrLf & _
    Format(dDateTimeEnd, "mmm dd yyyy" & ", hh:mm:ss") & " End Time" & vbCrLf & _
    Format(dDateTimeStart, "mmm dd yyyy" & ", hh:mm:ss") & " Start Time" & vbCrLf & vbCrLf & _
    sOut & " , " & sLab

'WITH SOME TIME INFO MISSING - DEFAULTS TO MIDNIGHT
    
    'set the incomplete date-times for calculation
    'first item has no time data so DEFAULTS TO MIDNIGHT
    dDateTimeStart = #1/5/2019# 'assumes time 0:0:0
    dDateTimeEnd = #1/7/2019 2:37:20 PM#
    
    'default time given as 2 days, 14 hours, 37 mins, and 20 seconds apart
    sOut = LapsedTime(dDateTimeEnd, dDateTimeStart, "dhms", sLab)
    MsgBox "Default value of Lapsed Time:" & vbCrLf & "When time data is missing," & vbCrLf & _
    "midnight is assumed:" & vbCrLf & vbCrLf & _
    Format(dDateTimeEnd, "mmm dd yyyy" & ", hh:mm:ss") & " End Time" & vbCrLf & _
    Format(dDateTimeStart, "mmm dd yyyy") & " Start Time" & vbCrLf & "becomes " & vbCrLf & _
    Format(dDateTimeStart, "mmm dd yyyy" & ", hh:mm:ss") & " Start Time" & vbCrLf & vbCrLf & _
    sOut & " , " & sLab

End Sub

Function LapsedTime(dTimeEnd As Date, dTimeStart As Date, _
      sConfig As String, Optional sLegend As String) As String
    'Returns difference of two dates (date-times) in function name.
    'Choice of various colon-separated outputs with sConfig.
    'and Optional format label found in string sLegend
    
    Dim sOut As String
    Dim dDiff As Date
        
    'Parameter Options for sConfig
    ' "s"    output in seconds. Integer.
    ' "ms"   output in minutes and seconds. mm:ss
    ' "hms"  output in hours, minutes and seconds. hh:mm:ss
    ' "dhms" output in days, hours, minutes and seconds. integer:hh:mm:ss
    
    'test parameters
    If Not IsDate(dTimeStart) Then
        MsgBox "Invalid parameter start date - closing."
    ElseIf Not IsDate(dTimeEnd) Then
        MsgBox "Invalid parameter end date - closing."
        Exit Function
    End If
    
    'difference as date-time data
    dDiff = dTimeEnd - dTimeStart
  
    'choose required output format
    Select Case sConfig
    Case "s" 'output in seconds.
        sOut = Int(CSng(dDiff * 24 * 3600))
        sLegend = "secs"
    Case "ms" 'output in minutes and seconds
        sOut = Int(CSng(dDiff * 24 * 60)) & ":" & Format(dDiff, "ss")
        sLegend = "mins:secs"
    Case "hms" 'output in hours, minutes and seconds
        sOut = Int(CSng(dDiff * 24)) & ":" & Format(dDiff, "nn:ss")
        sLegend = "hrs:mins:secs"
    Case "dhms" 'output in days, hours, minutes and seconds
        sOut = Int(CSng(dDiff)) & ":" & Format(dDiff, "hh") _
            & ":" & Format(dDiff, "nn") & ":" & _
            Format(dDiff, "ss")
        sLegend = "days:hrs:mins:secs"
    Case Else
        MsgBox "Illegal format option - closing"
        Exit Function
    End Select
    
    LapsedTime = sOut

End Function

另请参见

计算经过时间 - Microsoft: Microsoft 的一篇文章，介绍了避免时间比较错误的方法。