Блог

Я использую DateAddWorkdays в своей базе данных access, в которой есть серверная часть SQL, которая большую часть времени отлично работает. Но у меня возникают некоторые странные несоответствия, и я не знаю, почему. Я просматривал сценарий в течение последних нескольких часов и не вижу, откуда берется проблема. У меня есть таблица дат, которая включает 25 октября 2021 года в качестве праздничного дня:

Я использую поле Дата праздника. Я вызываю функцию с помощью

 Me.ProductionDate = DateAddWorkdays(-Me.Lag, Me.DelDate)
 

Это отрицательное число, так как мне нужно отсчитать количество дней задержки, чтобы знать, когда начать производство товаров вовремя к дате доставки (я. DelDate).
Как показано ниже, если есть только 2 дня, он отлично отсчитывается до 21 октября, так как 25-е число считается праздничным, а 23-е и 24-е-выходными днями. Но если задержка составляет 6 дней, он где-то пропускает день и возвращает 18-е число, где я ожидал бы, что он должен вернуться в предыдущую пятницу 15-го числа (чтобы проверить эту теорию, если я изменю дату доставки на 27 октября, в результате он также вернет 18-е число).

Несмотря на то, что я прошел через сценарий, я не до конца понимаю, что он делает, поэтому я надеюсь, что кто-нибудь сможет показать мне, почему у меня возникает это несоответствие.
Я возился с некоторым форматированием даты, так как это вызывало проблемы в других местах, но в этом сценарии, похоже, это включено.

     Option Compare Database
Option Explicit
    
Public Function DateAddWorkdays( _
    ByVal lngNumber As Long, _
    ByVal datDate As Date, _
    Optional ByVal booWorkOnHolidays As Boolean) _
    As Date

'   Adds lngNumber of workdays to datDate.
'   2014-10-03. Cactus Data ApS, CPH

    ' Calendar days per week.
    Const clngWeekdayCount  As Long = 7
    ' Workdays per week.
    Const clngWeekWorkdays  As Long = 5
    ' Average count of holidays per week maximum.
    Const clngWeekHolidays  As Long = 1
    ' Maximum valid date value.
    Const cdatDateRangeMax  As Date = #12/31/9999#
    ' Minimum valid date value.
    Const cdatDateRangeMin  As Date = #1/1/100#

    Dim aHolidays() As Date

    Dim lngDays     As Long
    Dim lngDiff     As Long
    Dim lngDiffMax  As Long
    Dim lngSign     As Long
    Dim datDate1    As Date
    Dim datDate2    As Date
    Dim datLimit    As Date
    Dim lngHoliday  As Long


    lngSign = Sgn(lngNumber)
    datDate2 = datDate

    If lngSign <> 0 Then
        If booWorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between datDate and datDate   lngDiffMax.
            ' Calculate the maximum calendar days per workweek.
            lngDiffMax = lngNumber * clngWeekdayCount / (clngWeekWorkdays - clngWeekHolidays)
            ' Add one week to cover cases where a week contains multiple holidays.
            lngDiffMax = lngDiffMax   Sgn(lngDiffMax) * clngWeekdayCount
            datDate1 = DateAdd("d", lngDiffMax, datDate)
            aHolidays = GetHolidays(datDate, datDate1)
        End If
        Do Until lngDays = lngNumber
            If lngSign = 1 Then
                datLimit = cdatDateRangeMax
            Else
                datLimit = cdatDateRangeMin
            End If
            If DateDiff("d", DateAdd("d", lngDiff, datDate), datLimit) = 0 Then
                ' Limit of date range has been reached.
                Exit Do
            End If

            lngDiff = lngDiff   lngSign
            datDate2 = DateAdd("d", lngDiff, datDate)
            Select Case Weekday(datDate2)
                Case vbSaturday, vbSunday
                    ' Skip weekend.
                Case Else
                    ' Check for holidays to skip.
                    ' Ignore error when using LBound and UBound on an unassigned array.
                    On Error Resume Next
                    For lngHoliday = LBound(aHolidays) To UBound(aHolidays)
                        If Err.Number > 0 Then
                            ' No holidays between datDate and datDate1.
                        ElseIf DateDiff("d", datDate2, aHolidays(lngHoliday)) = 0 Then
                            ' This datDate2 hits a holiday.
                            ' Subtract one day before adding one after the loop.
                            lngDays = lngDays - lngSign
                            Exit For
                        End If
                    Next
                    On Error GoTo 0
                    lngDays = lngDays   lngSign
            End Select
        Loop
    End If

    DateAddWorkdays = datDate2
    End Function

    Public Function GetHolidays( _
    ByVal datDate1 As Date, _
    ByVal datDate2 As Date, _
    Optional ByVal booDesc As Boolean) _
    As Date()

'   Finds the count of holidays between datDate1 and datDate2.
'   The holidays are returned as an array of dates.
'   DAO objects are declared static to speed up repeated calls with identical date parameters.
'   2014-10-03. Cactus Data ApS, CPH

    ' The table that holds the holidays.
    Const cstrTable             As String = "tblHoliday"
    ' The field of the table that holds the dates of the holidays.
    Const cstrField             As String = "HolidayDate"
    ' Constants for the arrays.
    Const clngDimRecordCount    As Long = 2
    Const clngDimFieldOne       As Long = 0

    Static dbs              As DAO.Database
    Static rst              As DAO.Recordset

    Static datDate1Last     As Date
    Static datDate2Last     As Date

    Dim adatDays()  As Date
    Dim avarDays    As Variant

    Dim strSQL      As String
    Dim strDate1    As String
    Dim strDate2    As String
    Dim strOrder    As String
    Dim lngDays     As Long

    If DateDiff("d", datDate1, datDate1Last) <> 0 Or DateDiff("d", datDate2, datDate2Last) <> 0 Then
        ' datDate1 or datDate2 has changed since the last call.
        strDate1 = Format(datDate1, "#yyyy/mm/dd#")
        strDate2 = Format(datDate2, "#yyyy/mm/dd#")
        strOrder = Format(booDesc, "Asc;Desc")

        strSQL = "Select " amp; cstrField amp; " From " amp; cstrTable amp; " " amp; _
            "Where " amp; cstrField amp; " Between " amp; strDate1 amp; " And " amp; strDate2 amp; " " amp; _
            "Order By 1 " amp; strOrder

        Set dbs = CurrentDb
        Set rst = dbs.OpenRecordset(strSQL, dbOpenSnapshot)

        ' Save the current set of date parameters.
        datDate1Last = datDate1
        datDate2Last = datDate2
    End If

    lngDays = rst.RecordCount
    If lngDays = 0 Then
        ' Leave adatDays() as an unassigned array.
    Else
        ReDim adatDays(lngDays - 1)
        ' As repeated calls may happen, do a movefirst.
        rst.MoveFirst
        avarDays = rst.GetRows(lngDays)
        ' rst is now positioned at the last record.
        For lngDays = LBound(avarDays, clngDimRecordCount) To UBound(avarDays, clngDimRecordCount)
            adatDays(lngDays) = avarDays(clngDimFieldOne, lngDays)
        Next
    End If

    ' DAO objects are static.
    ' Set rst = Nothing
    ' Set dbs = Nothing

    GetHolidays = adatDays()

End Function
 

В дополнение к моему вопросу в комментариях ниже я наткнулся на другой пример, в котором расчет не согласуется. Выше указана дата доставки 11/01/2022, которая приходится на 11 января 2022 года, и с задержкой в 2 дня она правильно рассчитывается, включая праздничные дни, из таблицы ниже. Но отставание где-то между 9 и 14, и, похоже, оно игнорирует праздники, но до тех пор, пока отставание меньше 9 или больше 14, оно вычисляется правильно.

Ошибка заключается в том, что расширенный диапазон возможных праздников не соответствовал знаку интервала дат, что в вашем случае привело к исключению праздника:

             ' Retrieve array with holidays between datDate and datDate   lngDiffMax.
            ' Calculate the maximum calendar days per workweek.
            lngDiffMax = lngNumber * clngWeekdayCount / (clngWeekWorkdays - clngWeekHolidays)

            ' Add one week to cover cases where a week contains multiple holidays.
'' Missing sign.
''            lngDiffMax = lngDiffMax   clngWeekdayCount
'' Corrected to follow the sign of the date interval.
            lngDiffMax = lngDiffMax   Sgn(lngDiffMax) * clngWeekdayCount

            datDate1 = DateAdd("d", lngDiffMax, datDate)
            aHolidays = GetHolidays(datDate, datDate1)
 

Теперь вы можете запустить этот быстрый тест:

 For n = 0 To 7 : ? d, -n, DateAddWorkdays(-n, d) : Next
26-10-2021     0            26-10-2021 
26-10-2021    -1            22-10-2021 
26-10-2021    -2            21-10-2021 
26-10-2021    -3            20-10-2021 
26-10-2021    -4            19-10-2021 
26-10-2021    -5            18-10-2021 
26-10-2021    -6            15-10-2021 
26-10-2021    -7            14-10-2021 
 

Функция была доработана и включена в мой проект VBA.Дата в модуле DateWork.bas . (Отказ от ответственности: Проект содержит обширный код, написанный мной).

Продленные каникулы

Увеличьте максимальное количество возможных праздничных дней в неделю до количества рабочих дней в неделю минус один:

 ' Common constants.
    
    ' Workdays per week.
    Public Const WorkDaysPerWeek    As Long = 5
    ' Average count of holidays per week maximum.
    Public Const HolidaysPerWeek    As Long = 4 '1
 

Теперь ваш образец будет работать следующим образом:

 Lag  Production Date 
---  ---------------
  1  10-01-2022 
  2  21-12-2021 
  3  20-12-2021 
  4  17-12-2021 
  5  16-12-2021 
  6  15-12-2021 
  7  14-12-2021 
  8  13-12-2021 
  9  10-12-2021 
 10  09-12-2021 
 11  08-12-2021 
 12  07-12-2021 
 13  06-12-2021 
 14  03-12-2021 
 15  02-12-2021 
 16  01-12-2021