Count X Количество рабочих дней с даты ввода

Question

У меня есть база данных Microsoft Access, где пользователю необходимо ввести значение Date Opened:. После ввода это вызывает вычисление в другом поле, Deadline (25 WD):. Это работает с помощью следующей функции в последнем поле:

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

То, что я хочу сделать, однако, считать 25 рабочих дней с даты, введенной в Date Opened:. У меня есть таблица holidays, которая содержит список британских праздников вплоть до 2020 года.

Как я могу объединить до двух, так сказать, чтобы создать допустимое значение Deadline (25 WD):, которое не учитывает ни одну из приведенных ниже дат в holidays?

Например, если введенная дата 01/01/2015, функция будет считаться 25 рабочих дней с 01/01/2015, что означает, что она исключает все выходные и праздничные дни, которые относятся к этому периоду, и итоговое значение даты в поле 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 

Надеюсь, это поможет!

EDIT: Я добавил еще один цикл, чтобы узнать, выпадает ли дата окончания на банковский праздник или выходные дни, если он добавит еще один день, пока он не достигнет буднего дня.

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