几年之间的DateDiff导致错误的结果

Posted 2021-05-04

我从互联网上获得了这个功能。到目前为止计算天数时它表现不错，但是当日期来自不同年份时，结果是错误的。例：

dateFrom = "2017-12-26"
dateTo = "2018-01-02"

结果将是28天，当它应该是6天。

这是功能：

Public Function NetWorkdays(dtStartDate, dtEndDate, arrHolidays)
    Dim lngDays
    Dim lngSaturdays
    Dim lngSundays
    Dim lngHolidays
    Dim lngAdjustment
    Dim dtTest
    Dim i, x

    lngDays = DateDiff("d", dtStartDate, dtEndDate)
    lngSundays = DateDiff("ww", dtStartDate, dtEndDate, vbSunday)
    lngSaturdays = DateDiff("w", IIf(Weekday(dtStartDate, vbSunday) = vbSaturday, dtStartDate, dtStartDate - Weekday(dtStartDate, vbSunday)), dtEndDate)

    For x = LBound(arrHolidays) To UBound(arrHolidays)
        For i = 0 To lngDays
            dtTest = DateAdd("d", i, dtStartDate)
            If arrHolidays(x) = dtTest And Weekday(dtTest) <> 1 And Weekday(dtTest) <> 7 Then
                lngHolidays = lngHolidays + 1
            End If
        Next
    Next

    If Weekday(dtStartDate, vbSunday) = vbSunday Or Weekday(dtStartDate, vbSunday) = vbSaturday Then
        lngAdjustment = 0
    Else
        lngAdjustment = 1
    End If

    NetWorkdays = lngDays - lngSundays - lngSaturdays - lngHolidays + lngAdjustment
End Function

Public Function IIf(expr, truepart, falsepart)
    If expr Then IIf = truepart Else IIf = falsepart
End function

任何人都可以指出要修理的东西吗？

答案

dateFrom = #2017-12-26#
dateTo = #2018-01-02#
Msgbox Dateto - datefrom,, "Result"

回报

---------------------------
Result
---------------------------
7
---------------------------
OK   
---------------------------

另一答案

正如原型中的类型前缀所示：

Public Function NetWorkdays(dtStartDate, dtEndDate, arrHolidays)

函数需要Dates，而不是字符串。证据：

Option Explicit

(copy of function)

Dim dp, n
For Each dp In Array(Array("2017-12-26", "2018-01-02"))
   On Error Resume Next
    n = NetWorkdays(dp(0), dp(1), Array())
    If Err Then n = Err.Description
   On Error GoTo 0
    WScript.Echo TypeName(dp(0)), dp(0), dp(1), n 
    dp(0) = CDate(dp(0))
    dp(1) = CDate(dp(1))
    WScript.Echo TypeName(dp(0)), dp(0), dp(1), NetWorkdays(dp(0), dp(1), Array()) 

Next

输出（德语区域）：

cscript 47921079.vbs
String 2017-12-26 2018-01-02 Typenkonflikt
Date 26.12.2017 02.01.2018 6

根据版本，区域设置和月亮的相位，您可能必须用更可靠的东西替换CDate（）调用。