为什么我的CalcWorkingDays VBA函数在同一期间给我两个不同的结果?

时间:2019-06-17 11:11:27

标签: vba date ms-access

首先,我是一个初学者,还在学习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天

4 个答案:

答案 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

this one

答案 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

您会看到,其核心不过是一个简单的循环,循环如此之快,以至于尝试进行优化都无法为典型用法带来回报。