首先,我是一个初学者,还在学习VBA,谢谢您的考虑。
我有一个CalcWorkingDays
函数,该函数计算特定时间段(由查询参数定义的时间)内的工作日。
但是当它返回结果时,在某些时期它是完全正确的,而在另一些时期它是不正确的(请参见最后的示例)
我想问题出在这些方面:
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`
例如,在2019年3月。 总共有21个工作日。我们有员工A和B A:他在一个项目中,从01/01/2019到31/12/2019,该功能给了我21个工作日进行游行,这是正确的 B:他从01/03/2019到08/03/2019被分配到一个项目,它给我5个错误的答案,应该给我6个(总共8天-周末2天
答案 0 :(得分:1)
受骚扰的父亲是正确的-如果您使用Format(DateCnt, "w")
,则星期日为“ 1”,星期一为“ 2” ...
但是您不应该使用Format
来获取星期几-Format
用于将数据格式化到字符串中,并且不需要包含字符串。请改用Weekday
函数。
Weekday
的默认行为是星期日将为1(作为数字,而不是字符串),但是您可以使用第二个参数(FirstDayOfWeek
)进行更改。这定义了您希望将哪一天作为一周的第一天。
因此您可以将逻辑更改为
If Weekday(DateCnt, vbMonday) < 6 Then
答案 1 :(得分:0)
也许您尝试使用功能networkdays
=NETWORKDAYS(start_date,end_date,holidays)
假期是可选的
例如,如果您在单元格B4中具有2016年1月4日(星期一),在单元格C4中具有2016年1月11日(也是星期一),则此公式将返回6:
=NETWORKDAYS(B4,C4)
用于ACCESS中的VBA
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
OR
答案 2 :(得分:0)
日期算术比较棘手。如果您不太在意效率,并且您的时间间隔相对较小,那么一个非常简单的函数就可以解决问题
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
不是特别优雅,但是有效,易于理解和易于修改。
答案 3 :(得分:0)
该功能为我提供了21个工作日,这是正确的B
他已从01/03/2019到08/03/2019被分配到一个项目 给我5个错误,应该给我6个。
差异功能将永远不会包含最后日期。如果您希望包含最后一个日期,请在计算之前添加最后一天的日期:
? 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
也如前所述,将 Monday 指定为一周的第一天。此外,不要使用Format;工作日是“直接”方法。因此:
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
您会看到,其核心不过是一个简单的循环,循环如此之快,以至于尝试进行优化都无法为典型用法带来回报。