从日期计数工作的X日进入(Count X Amount of Working Days from D

2019-10-29 04:08发布

我有其中要求用户输入Microsoft Access数据库Date Opened:值。 一旦输入,这会触发在另一个领域,计算Deadline (25 WD): 这通过在后场以下功能的工作原理:

=DateAdd("d",25,[Date opened])

我想要做什么,但是,是从输入的日期计25 个工作日内Date Opened: 。 我有一个表holidays其中包含英国假期,直到2020年名单。

我该如何合并两个,所以来讲话,以产生一个有效Deadline (25 WD):值,不计任何上市日期的holidays

例如,如果输入的日期为2015年1月1日,则该函数将被计25个工作日内从2015年1月1日,这意味着它会排除所有的周末和秋季该期间内的任何银行假期而产生的日期值在外地Deadline (25 WD)也将成为一个工作日(即不是周末或银行假日)。

Answer 1:

您可能需要一个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 

希望这可以帮助 !

编辑:我已经加入另一个循环,看是否结束日期适逢银行假日和周末,如果是这样,直到它到达一个工作日就会增加一天。



Answer 2:

您可以使用此功能:

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


文章来源: Count X Amount of Working Days from Date Entered