應用程式/日期之間的時間差

摘要

此模組包含用於計算兩個完整表達日期之間的時間差的 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 的一篇文章，介紹了避免時間比較錯誤的方法。