我有一个Microsoft Access数据库，用户需要输入Date Opened:值。输入后，将触发另一个字段Deadline (25 WD):中的计算。这通过后一领域的以下功能起作用：
=DateAdd("d",25,[Date opened])
但是，我想要做的是从Date Opened:中输入的日期算起25天工作天。我有一张表holidays，其中包含截至2020年的英国假期列表。
为了生成有效Deadline (25 WD):值而不计算holidays中列出的任何日期，我如何合并为两个，可以这么说？
例如，如果输入的日期是01/01/2015，那么该功能将从2015年1月1日起计算25个工作日，这意味着它将排除所有周末和任何属于该期间的银行假日，并且< strong>字段Deadline (25 WD)中的结果日期值也将是工作日（即不是周末或银行假日）。
答案 0 :(得分：1)
您可以使用此功能：
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, "\A\s\c;\D\e\s\c")
strSQL = "Select " & cstrField & " From " & cstrTable & " " & _
"Where " & cstrField & " Between " & strDate1 & " And " & strDate2 & " " & _
"Order By 1 " & 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
答案 1 :(得分：0)
您可能需要一个UDF来帮助您完成此操作。像，
Function addWorkDays(addNumber As Long, Date2 As Date) As Date
'********************
'Code Courtesy of
' Paul Eugin
'********************
Dim finalDate As Date
Dim i As Long, tmpDate As Date
tmpDate = Date2
i = 1
Do While i <= addNumber
If Weekday(tmpDate) <> 1 And Weekday(tmpDate) <> 7 And _
DCount("*", "tbl_BankHolidays", "bankDate = " & Format(tmpDate, "\#mm\/dd\/yyyy\#")) = 0 Then i = i + 1
tmpDate = DateAdd("d", 1, tmpDate)
Loop
Do While Weekday(tmpDate) = 1 Or Weekday(tmpDate) = 7 Or _
DCount("*", "tbl_BankHolidays", "bankDate = " & Format(tmpDate, "\#mm\/dd\/yyyy\#")) <> 0
tmpDate = DateAdd("d", 1, tmpDate)
Loop
addWorkDays = tmpDate
End Function
因此，当您将25天添加到某个日期时，它将跳过存储在您的表格中的所有周末和银行假日 - tbl_BankHolidays。
? addWorkDays(25, Date())
25/06/2015
希望这有帮助！
编辑：我添加了另一个循环来查看结束日期是在银行假日还是周末，如果是，它会再添加一天，直到它达到工作日。