为什么CalcWorkingDays VBA函数会在同一时间段内给出两个不同的结果？
首先，我是一名初学者，仍在学习VBA，谢谢您的考虑 我有一个CalcWorkDays函数，它计算查询参数定义的特定期间内的工作日 但当它返回结果时，在某些时段它是完全正确的，而在另一些时段它是不正确的，请参见最后的示例 我想问题在于这些方面：为什么CalcWorkingDays VBA函数会在同一时间段内给出两个不同的结果？,vba,date,ms-access,Vba,Date,Ms Access,首先，我是一名初学者，仍在学习VBA，谢谢您的考虑 我有一个CalcWorkDays函数，它计算查询参数定义的特定期间内的工作日 但当它返回结果时，在某些时段它是完全正确的，而在另一些时段它是不正确的，请参见最后的示例 我想问题在于这些方面： If Format(DateCnt, "w") <> "7" And _ Format(DateCnt, "w") <> "6" Then 谢谢大家! Public Function CalcWorkingDays(Beg
If Format(DateCnt, "w") <> "7" And _
Format(DateCnt, "w") <> "6" Then
Public Function CalcWorkingDays(BegDate As Variant, EndDate As Variant) As Integer
Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
On Error GoTo Err_Work_Days
BegDate = DateValue(BegDate)
EndDate = DateValue(EndDate)
WholeWeeks = DateDiff("w", BegDate, EndDate)
DateCnt = DateAdd("ww", WholeWeeks, BegDate)
EndDays = 0
Do While DateCnt <= EndDate
If Format(DateCnt, "w") <> "7" And _
Format(DateCnt, "w") <> "6" Then
EndDays = EndDays + 1
End If
DateCnt = DateAdd("d", 1, DateCnt)
Loop
CalcWorkingDays = WholeWeeks * 5 + EndDays
Exit Function
[...]
End Function`
B:他被分配到一个从2019年3月1日到2019年3月8日的项目，它给了我5天，这是不正确的，它应该给我6天8天-周末2天 假期是可以选择的 例如，如果在单元格B4中有2016年1月4日的星期一，在单元格C4中有2016年1月11日的星期一，则此公式将返回6：
=NETWORKDAYS(B4,C4)
Sub test()
Dim xl As Object
Set xl = CreateObject("Excel.Application")
BegDate = #4/11/2019#
EndDate = #6/11/2019#
result = xl.WorksheetFunction.NetworkDays(BegDate, EndDate) ' 44
Set xl = Nothing
End Sub
If Weekday(DateCnt, vbMonday) < 6 Then
日期算法很复杂。如果您不太关心效率，并且您的时间间隔相对较小，那么一个非常简单的函数就可以做到这一点
Public Function CalcWorkingDays(BegDate As Variant, EndDate As Variant) As Integer
CalcWorkingDays = 0
For i = begdate To enddate
If Weekday(i, vbMonday) <= 5 Then
CalcWorkingDays = CalcWorkingDays + 1
End If
Next
End Function
? DateDiffWorkDays(#2019/03/01#, #2019/03/31#)
21
? DateDiffWorkDays(#2019/03/01#, #2019/04/01#)
21
? DateDiffWorkDays(#2019/03/01#, #2019/03/08#)
5
? DateDiffWorkDays(#2019/03/01#, #2019/03/09#)
6
If Weekday(DateCnt, vbMonday) < 6 Then
EndDays = EndDays + 1
End If
Option Compare Database
Option Explicit
' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
' Mo Tu We Th Fr Sa Su Su Sa Fr Th We Tu Mo
' 0 1 2 3 4 4 4 0 0 -1 -2 -3 -4 -5
'
' Su Mo Tu We Th Fr Sa Sa Fr Th We Tu Mo Su
' 0 1 2 3 4 5 5 0 -1 -2 -3 -4 -5 -5
'
' Sa Su Mo Tu We Th Fr Fr Th We Tu Mo Su Sa
' 0 0 1 2 3 4 5 0 -1 -2 -3 -4 -4 -4
'
' Fr Sa Su Mo Tu We Th Th We Tu Mo Su Sa Fr
' 0 0 0 1 2 3 4 0 -1 -2 -3 -3 -3 -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateDiffWorkdays( _
ByVal Date1 As Date, _
ByVal Date2 As Date, _
Optional ByVal WorkOnHolidays As Boolean) _
As Long
Dim Holidays() As Date
Dim Diff As Long
Dim Sign As Long
Dim NextHoliday As Long
Dim LastHoliday As Long
Sign = Sgn(DateDiff("d", Date1, Date2))
If Sign <> 0 Then
If WorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between Date1 and Date2.
Holidays = GetHolidays(Date1, Date2, False) 'CBool(Sign < 0))
' Ignore error when using LBound and UBound on an unassigned array.
On Error Resume Next
NextHoliday = LBound(Holidays)
LastHoliday = UBound(Holidays)
' If Err.Number > 0 there are no holidays between Date1 and Date2.
If Err.Number > 0 Then
WorkOnHolidays = True
End If
On Error GoTo 0
End If
' Loop to sum up workdays.
Do Until DateDiff("d", Date1, Date2) = 0
Select Case Weekday(Date1)
Case vbSaturday, vbSunday
' Skip weekend.
Case Else
If WorkOnHolidays = False Then
' Check for holidays to skip.
If NextHoliday <= LastHoliday Then
' First, check if NextHoliday hasn't been advanced.
If NextHoliday < LastHoliday Then
If Sgn(DateDiff("d", Date1, Holidays(NextHoliday))) = -Sign Then
' Weekend hasn't advanced NextHoliday.
NextHoliday = NextHoliday + 1
End If
End If
' Then, check if Date1 has reached a holiday.
If DateDiff("d", Date1, Holidays(NextHoliday)) = 0 Then
' This Date1 hits a holiday.
' Subtract one day to neutralize the one
' being added at the end of the loop.
Diff = Diff - Sign
' Adjust to the next holiday to check.
NextHoliday = NextHoliday + 1
End If
End If
End If
Diff = Diff + Sign
End Select
' Advance Date1.
Date1 = DateAdd("d", Sign, Date1)
Loop
End If
DateDiffWorkdays = Diff
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
' 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
你会看到，它的核心只是一个简单的循环，它的速度如此之快，以至于尝试优化对于典型的使用是没有回报的。1=星期天，7=星期六，6=星期五如果语句计算的是星期五和星期六，而不是星期六和星期天，那么你可能会尝试使用函数networkdays@harassedad，正是这样，非常感谢！我花了很多天在这个简单的错误上！这对我来说是个新问题，似乎是最好的答案。如果必须从VBA调用它，则application.WorksheetFunction.networkdays例如，end可以正常工作。application.WorksheetFunction是一个Excel功能。这是一个访问问题，对。我没注意到。我需要更敏锐地观察。
Option Compare Database
Option Explicit
' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
' Mo Tu We Th Fr Sa Su Su Sa Fr Th We Tu Mo
' 0 1 2 3 4 4 4 0 0 -1 -2 -3 -4 -5
'
' Su Mo Tu We Th Fr Sa Sa Fr Th We Tu Mo Su
' 0 1 2 3 4 5 5 0 -1 -2 -3 -4 -5 -5
'
' Sa Su Mo Tu We Th Fr Fr Th We Tu Mo Su Sa
' 0 0 1 2 3 4 5 0 -1 -2 -3 -4 -4 -4
'
' Fr Sa Su Mo Tu We Th Th We Tu Mo Su Sa Fr
' 0 0 0 1 2 3 4 0 -1 -2 -3 -3 -3 -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateDiffWorkdays( _
ByVal Date1 As Date, _
ByVal Date2 As Date, _
Optional ByVal WorkOnHolidays As Boolean) _
As Long
Dim Holidays() As Date
Dim Diff As Long
Dim Sign As Long
Dim NextHoliday As Long
Dim LastHoliday As Long
Sign = Sgn(DateDiff("d", Date1, Date2))
If Sign <> 0 Then
If WorkOnHolidays = True Then
' Holidays are workdays.
Else
' Retrieve array with holidays between Date1 and Date2.
Holidays = GetHolidays(Date1, Date2, False) 'CBool(Sign < 0))
' Ignore error when using LBound and UBound on an unassigned array.
On Error Resume Next
NextHoliday = LBound(Holidays)
LastHoliday = UBound(Holidays)
' If Err.Number > 0 there are no holidays between Date1 and Date2.
If Err.Number > 0 Then
WorkOnHolidays = True
End If
On Error GoTo 0
End If
' Loop to sum up workdays.
Do Until DateDiff("d", Date1, Date2) = 0
Select Case Weekday(Date1)
Case vbSaturday, vbSunday
' Skip weekend.
Case Else
If WorkOnHolidays = False Then
' Check for holidays to skip.
If NextHoliday <= LastHoliday Then
' First, check if NextHoliday hasn't been advanced.
If NextHoliday < LastHoliday Then
If Sgn(DateDiff("d", Date1, Holidays(NextHoliday))) = -Sign Then
' Weekend hasn't advanced NextHoliday.
NextHoliday = NextHoliday + 1
End If
End If
' Then, check if Date1 has reached a holiday.
If DateDiff("d", Date1, Holidays(NextHoliday)) = 0 Then
' This Date1 hits a holiday.
' Subtract one day to neutralize the one
' being added at the end of the loop.
Diff = Diff - Sign
' Adjust to the next holiday to check.
NextHoliday = NextHoliday + 1
End If
End If
End If
Diff = Diff + Sign
End Select
' Advance Date1.
Date1 = DateAdd("d", Sign, Date1)
Loop
End If
DateDiffWorkdays = Diff
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
' 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