ms access - Query에서 사용하는 VBA 함수가 예상 날짜를 계산하지 않습니다

NumDays 인 경우   Do While 에 대한 테스트식이 음수 임   intCount = 0 이후 루프는 검증되지 않습니다.   NumDays 보다 큰 .

intCount < NumDays

그러므로 루프는 평가되지 않으며 dtmCurr   StartDate 와 동일하게 유지됩니다 .

일을 되돌리려면 변수 dtmCurr 에서 일을 빼는 논리를 포함하도록 함수를 변경해야합니다. , 현재 함수가 추가하기 위해 하드 코딩되었으므로 :

dtmCurr = dtmCurr + 1

코드를 간략하게 검토 한 후 다음을 변경할 수 있습니다.

Do While intCount < NumDays

받는 사람 :

Do While intCount < Abs(NumDays)

그리고 :

dtmCurr = dtmCurr + 1

받는 사람 :

dtmCurr = dtmCurr + Sgn(NumDays)

내 기능을 사용할 수 있습니다. 앞뒤로 계산됩니다.

Option Explicit
' Common constants.
    ' Date.
    Public Const DaysPerWeek        As Long = 7
    Public Const MaxDateValue       As Date = #12/31/9999#
    Public Const MinDateValue       As Date = #1/1/100#
    ' Workdays per week.
    Public Const WorkDaysPerWeek    As Long = 5
    ' Average count of holidays per week maximum.
    Public Const HolidaysPerWeek    As Long = 1
' Adds Number of full workdays to Date1 and returns the found date.
' Number can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are counted as workdays.
'
' For excessive parameters that would return dates outside the range
' of Date, either 100-01-01 or 9999-12-31 is returned.
'
' Will add 500 workdays in about 0.01 second.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateAddWorkdays( _
    ByVal Number As Long, _
    ByVal Date1 As Date, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Date
    Const Interval      As String = "d"
    Dim Holidays()      As Date
    Dim Days            As Long
    Dim DayDiff         As Long
    Dim MaxDayDiff      As Long
    Dim Sign            As Long
    Dim Date2           As Date
    Dim NextDate        As Date
    Dim DateLimit       As Date
    Dim HolidayId       As Long
    Sign = Sgn(Number)
    NextDate = Date1
    If Sign <> 0 Then
        If WorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between Date1 and Date1 + MaxDayDiff.
            ' Calculate the maximum calendar days per workweek.
            MaxDayDiff = Number * DaysPerWeek / (WorkDaysPerWeek - HolidaysPerWeek)
            ' Add one week to cover cases where a week contains multiple holidays.
            MaxDayDiff = MaxDayDiff + Sgn(MaxDayDiff) * DaysPerWeek
            If Sign > 0 Then
                If DateDiff(Interval, Date1, MaxDateValue) < MaxDayDiff Then
                    MaxDayDiff = DateDiff(Interval, Date1, MaxDateValue)
                End If
            Else
                If DateDiff(Interval, Date1, MinDateValue) > MaxDayDiff Then
                    MaxDayDiff = DateDiff(Interval, Date1, MinDateValue)
                End If
            End If
            Date2 = DateAdd(Interval, MaxDayDiff, Date1)
            ' Retrive array with holidays.
            Holidays = GetHolidays(Date1, Date2)
        End If
        Do Until Days = Number
            If Sign = 1 Then
                DateLimit = MaxDateValue
            Else
                DateLimit = MinDateValue
            End If
            If DateDiff(Interval, DateAdd(Interval, DayDiff, Date1), DateLimit) = 0 Then
                ' Limit of date range has been reached.
                Exit Do
            End If
            DayDiff = DayDiff + Sign
            NextDate = DateAdd(Interval, DayDiff, Date1)
            Select Case Weekday(NextDate)
                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 HolidayId = LBound(Holidays) To UBound(Holidays)
                        If Err.Number > 0 Then
                            ' No holidays between Date1 and Date2.
                        ElseIf DateDiff(Interval, NextDate, Holidays(HolidayId)) = 0 Then
                            ' This NextDate hits a holiday.
                            ' Subtract one day before adding one after the loop.
                            Days = Days - Sign
                            Exit For
                        End If
                    Next
                    On Error GoTo 0
                    Days = Days + Sign
            End Select
        Loop
    End If
    DateAddWorkdays = NextDate
End Function
' Returns the holidays between Date1 and Date2.
' The holidays are returned as a recordset with the
' dates ordered ascending, optionally descending.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatesHoliday( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal ReverseOrder As Boolean) _
    As DAO.Recordset
    ' The table that holds the holidays.
    Const Table         As String = "Holiday"
    ' The field of the table that holds the dates of the holidays.
    Const Field         As String = "Date"
    Dim rs              As DAO.Recordset
    Dim SQL             As String
    Dim SqlDate1        As String
    Dim SqlDate2        As String
    Dim Order           As String
    SqlDate1 = Format(Date1, "\#yyyy\/mm\/dd\#")
    SqlDate2 = Format(Date2, "\#yyyy\/mm\/dd\#")
    ReverseOrder = ReverseOrder Xor (DateDiff("d", Date1, Date2) < 0)
    Order = IIf(ReverseOrder, "Desc", "Asc")
    SQL = "Select " & Field & " From " & Table & " " & _
        "Where " & Field & " Between " & SqlDate1 & " And " & SqlDate2 & " " & _
        "Order By 1 " & Order
    Set rs = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
    Set DatesHoliday = rs
End Function
' Returns the holidays between Date1 and Date2.
' The holidays are returned as an array with the
' dates ordered ascending, optionally descending.
'
' The array is declared static to speed up
' repeated calls with identical date parameters.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function GetHolidays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal OrderDesc As Boolean) _
    As Date()
    ' Constants for the arrays.
    Const DimRecordCount    As Long = 2
    Const DimFieldOne       As Long = 0
    Static Date1Last        As Date
    Static Date2Last        As Date
    Static OrderLast        As Boolean
    Static DayRows          As Variant
    Static Days             As Long
    Dim rs                  As DAO.Recordset
    ' Cannot be declared Static.
    Dim Holidays()          As Date
    If DateDiff("d", Date1, Date1Last) <> 0 Or _
        DateDiff("d", Date2, Date2Last) <> 0 Or _
        OrderDesc <> OrderLast Then
        ' Retrieve new range of holidays.
        Set rs = DatesHoliday(Date1, Date2, OrderDesc)
        ' Save the current set of date parameters.
        Date1Last = Date1
        Date2Last = Date2
        OrderLast = OrderDesc
        Days = rs.RecordCount
            If Days > 0 Then
                ' As repeated calls may happen, do a movefirst.
                rs.MoveFirst
                DayRows = rs.GetRows(Days)
                ' rs is now positioned at the last record.
            End If
        rs.Close
    End If
    If Days = 0 Then
        ' Leave Holidays() as an unassigned array.
        Erase Holidays
    Else
        ' Fill array to return.
        ReDim Holidays(Days - 1)
        For Days = LBound(DayRows, DimRecordCount) To UBound(DayRows, DimRecordCount)
            Holidays(Days) = DayRows(DimFieldOne, Days)
        Next
    End If
    Set rs = Nothing
    GetHolidays = Holidays()
End Function