在部署MSDN函数计算工作日时，除了日期格式问题外，我发现了Holiday count的问题。
计算是正确的，但只有假期是在工作日。如果它是在星期六或星期日，它也会减去它并产生错误的结果。 illustration of a false reading
工作日的功能：
Public Function Workdays(ByRef startDate As Date, ByRef endDate As Date, Optional ByRef strHolidays As String = "Holidays") As Integer
On Error GoTo Workdays_Error
Dim nWeekdays, nHolidays As Integer
Dim strWhere As String
startDate = DateValue(startDate)
endDate = DateValue(endDate)
nWeekdays = Weekdays(startDate, endDate)
If nWeekdays = -1 Then
Workdays = -1
GoTo Workdays_Exit
End If
strWhere = "[Holiday] >= #" & Format(startDate, "yyyy\/mm\/dd") & "# AND [Holiday] <= #" & Format(endDate, "yyyy\/mm\/dd") & "#"
nHolidays = DCount(Expr:="[Holiday]", Domain:=strHolidays, Criteria:=strWhere)
Workdays = nWeekdays - nHolidays
Workdays_Exit:
Exit Function
Resume Workdays_Exit
End Function
这是一个计算工作日的函数：
Public Function Weekdays(ByRef startDate As Date, ByRef endDate As Date) As Integer
' Returns the number of weekdays in the period from startDate
' to endDate inclusive. Returns -1 if an error occurs.
On Error GoTo Weekdays_Error
Const ncNumberOfWeekendDays As Integer = 2 'The number of weekend days per week.
Dim varDays As Variant 'The number of days inclusive.
Dim varWeekendDays As Variant 'The number of weekend days.
Dim dtmX As Date 'Temporary storage for datetime.
' If the end date is earlier, swap the dates.
If endDate < startDate Then
dtmX = startDate
startDate = endDate
endDate = dtmX
End If
' Calculate the number of days inclusive (+ 1 is to add back startDate).
varDays = DateDiff(Interval:="d", date1:=startDate, date2:=endDate) + 1
' Calculate the number of weekend days.
varWeekendDays = (DateDiff(Interval:="ww", date1:=startDate, date2:=endDate) _
* ncNumberOfWeekendDays) + IIf(DatePart(Interval:="w", _
Date:=startDate) = vbSunday, 1, 0) + IIf(DatePart(Interval:="w", Date:=endDate) = vbSaturday, 1, 0)
' Calculate the number of weekdays.
Weekdays = (varDays - varWeekendDays)
Weekdays_Exit:
Exit Function
Weekdays_Error:
Weekdays = -1
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Weekdays"
Resume Weekdays_Exit
如果假期= 1或假期= 7，请告知如何忽略假期。 另外，在很长一段时间内，周末可能会有不止一个假期，不论是否会下降。
答案 0 :(得分：1)
循环日期和计数要简单得多：
Public Function DateDiffWorkdays( _
ByVal datDate1 As Date, _
ByVal datDate2 As Date, _
Optional ByVal booWorkOnHolidays As Boolean) _
As Long
' Calculates the count of workdays between datDate1 and datDate2.
' 2014-10-03. Cactus Data ApS, CPH
Dim aHolidays() As Date
Dim lngDiff As Long
Dim lngSign As Long
Dim lngHoliday As Long
lngSign = Sgn(DateDiff("d", datDate1, datDate2))
If lngSign <> 0 Then
If booWorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between datDate1 and datDate2.
aHolidays = GetHolidays(datDate1, datDate2)
End If
Do Until DateDiff("d", datDate1, datDate2) = 0
Select Case Weekday(datDate1)
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 datDate1 and datDate2.
ElseIf DateDiff("d", datDate1, aHolidays(lngHoliday)) = 0 Then
' This datDate1 hits a holiday.
' Subtract one day before adding one after the loop.
lngDiff = lngDiff - lngSign
Exit For
End If
Next
On Error GoTo 0
lngDiff = lngDiff + lngSign
End Select
datDate1 = DateAdd("d", lngSign, datDate1)
Loop
End If
DateDiffWorkdays = lngDiff
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)
如果不深入研究您的代码，我建议您在假期表中计算假期，这些假期属于周末，并且也在您考虑的范围内。从（我推测）中减去总数，否则正确计算总数，你应该考虑周末假期进行适当的调整。
答案 2 :(得分：0)
您可以使用以下功能获取两个日期之间的工作日数（公众假期除外）。
它需要一个名为 tbHolidays 的表格，其中包含一个名为 _Date 的字段，用于保存公共假期。
Public Function WorkingDaysInDateRange(ByVal DateFrom As Date, _
ByVal DateTo As Date, _
Optional ByVal includeStartDate As Long = 0) As Long
On Error GoTo ErrorTrap
'Calculate the number of days
Dim lngTotalDays As Long
lngTotalDays = DateDiff("y", DateFrom, DateTo) + includeStartDate
'Calculate the number of weekend days.
Dim lngWeekendDays As Long
lngWeekendDays = (DateDiff("ww", DateFrom, DateTo) * 2) + _
IIf(DatePart("w", DateFrom) = vbSunday, 1, 0) + _
IIf(DatePart("w", DateTo) = vbSaturday, 1, 0)
'Get Non working days count from tbHolidays excluding weekends
Dim lngHolidays As Long
lngHolidays = DCount("[_Date]", "tbHolidays", _
StringFormat("[_Date] Between #{0}# AND #{1}# AND Weekday([_Date]) Not In ({2}, {3})", Format(DateFrom, "mm/dd/yyyy"), _
Format(DateTo, "mm/dd/yyyy"), _
vbSaturday, vbSunday))
Dim lngWrkDays As Long
lngWrkDays = lngTotalDays - (lngWeekendDays + lngHolidays)
'Return
WorkingDaysInDateRange = lngWrkDays
Leave:
On Error GoTo 0
Exit Function
ErrorTrap:
MsgBox Err.Description, vbCritical
Resume Leave
End Function
助手 StringFormat 功能：
Public Function StringFormat(ByVal Item As String, ParamArray args() As Variant) As String
Dim idx As Long
For idx = LBound(args) To UBound(args)
Item = Replace(Item, "{" & idx & "}", args(idx))
Next idx
StringFormat = Item
End Function