我用于计算未来到期日期的代码和查询正常运行，但是当我尝试使用相同的逻辑来计算所需的到期日期时，返回的日期为Start Date而不是Required by Date。
当我基于DateDue的{{1}}的{{1}}来计算StartDate时，8/1/19的计算日期为{{1} }不包括周末和节假日。
NumDays当我尝试更改此值以回溯计算30的日期时，9/13/19的{{1}}以DateDue: AddWorkDays([StartDate],[NumDays])
为NeededBy，即日期我们被送回的是StartDate，我希望看到8/1/19。
NumDays30这将计算出正确的未来日期：
8/1/19我希望它返回6/17/19，并且不包括周末和节假日，但是它将返回NeededBy: AddWorkDays([StartDate],-[NumDays])
：
Public Function AddWorkDays(StartDate As Date, NumDays As Integer) As Date
Dim rst As DAO.Recordset
Dim dbs As DAO.Database
Dim dtmCurr As Date
Dim intCount As Integer
On Error GoTo ErrHandler
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("tblHolidays", dbOpenSnapshot)
intCount = 0
dtmCurr = StartDate
Do While intCount < NumDays
dtmCurr = dtmCurr + 1
If Weekday(dtmCurr, vbMonday) < 6 Then
rst.FindFirst "[HolidayDate] = #" & Format(dtmCurr, "mm\/dd\/yyyy") & "#"
If rst.NoMatch Then
intCount = intCount + 1
End If
End If
Loop
AddWorkDays = dtmCurr
ExitHandler:
rst.Close
Set rst = Nothing
Set dbs = Nothing
Exit Function
ErrHandler:
MsgBox Err.Description, vbExclamation
Resume ExitHandler
End Function
答案 0 :(得分：0)
如果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)
答案 1 :(得分：0)
您可以使用我的功能。它将来回计数：
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