2016-11-09 68 views
0

我对MS Access很陌生。要求前一个工作日减公众假期

我需要从Excel相当于公式mc的从我的数据集少周末/公众假期访问这将锻炼-1天。

所以这是我在Excel中使用ATM:= WORKDAY(开始日期,天数,[节假日])

任何帮助将不胜感激。

回答

0

没有提供原生的功能,但你可以使用这套功能:

Option Explicit 

' Common constants. 

    ' Date. 
    Public Const DaysPerWeek  As Long = 7 
    Public Const MaxDateValue  As Date = #12/31/9999# 
    Public Const MinDateValue  As Date = #1/1/100# 
    ' Workdays per week. 
    Public Const WorkDaysPerWeek As Long = 5 
    ' Average count of holidays per week maximum. 
    Public Const HolidaysPerWeek As Long = 1 

' Adds Number of full workdays to Date1 and returns the found date. 
' Number can be positive, zero, or negative. 
' Optionally, if WorkOnHolidays is True, holidays are counted as workdays. 
' 
' For excessive parameters that would return dates outside the range 
' of Date, either 100-01-01 or 9999-12-31 is returned. 
' 
' Will add 500 workdays in about 0.01 second. 
' 
' Requires table Holiday with list of holidays. 
' 
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH. 
' 
Public Function DateAddWorkdays(_ 
    ByVal Number As Long, _ 
    ByVal Date1 As Date, _ 
    Optional ByVal WorkOnHolidays As Boolean) _ 
    As Date 

    Const Interval  As String = "d" 

    Dim Holidays()  As Date 

    Dim Days   As Long 
    Dim DayDiff   As Long 
    Dim MaxDayDiff  As Long 
    Dim Sign   As Long 
    Dim Date2   As Date 
    Dim NextDate  As Date 
    Dim DateLimit  As Date 
    Dim HolidayId  As Long 

    Sign = Sgn(Number) 
    NextDate = Date1 

    If Sign <> 0 Then 
     If WorkOnHolidays = True Then 
      ' Holidays are workdays. 
     Else 
      ' Retrieve array with holidays between Date1 and Date1 + MaxDayDiff. 
      ' Calculate the maximum calendar days per workweek. 
      MaxDayDiff = Number * DaysPerWeek/(WorkDaysPerWeek - HolidaysPerWeek) 
      ' Add one week to cover cases where a week contains multiple holidays. 
      MaxDayDiff = MaxDayDiff + Sgn(MaxDayDiff) * DaysPerWeek 
      If Sign > 0 Then 
       If DateDiff(Interval, Date1, MaxDateValue) < MaxDayDiff Then 
        MaxDayDiff = DateDiff(Interval, Date1, MaxDateValue) 
       End If 
      Else 
       If DateDiff(Interval, Date1, MinDateValue) > MaxDayDiff Then 
        MaxDayDiff = DateDiff(Interval, Date1, MinDateValue) 
       End If 
      End If 
      Date2 = DateAdd(Interval, MaxDayDiff, Date1) 
      ' Retrive array with holidays. 
      Holidays = GetHolidays(Date1, Date2) 
     End If 
     Do Until Days = Number 
      If Sign = 1 Then 
       DateLimit = MaxDateValue 
      Else 
       DateLimit = MinDateValue 
      End If 
      If DateDiff(Interval, DateAdd(Interval, DayDiff, Date1), DateLimit) = 0 Then 
       ' Limit of date range has been reached. 
       Exit Do 
      End If 

      DayDiff = DayDiff + Sign 
      NextDate = DateAdd(Interval, DayDiff, Date1) 
      Select Case Weekday(NextDate) 
       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 HolidayId = LBound(Holidays) To UBound(Holidays) 
         If Err.Number > 0 Then 
          ' No holidays between Date1 and Date2. 
         ElseIf DateDiff(Interval, NextDate, Holidays(HolidayId)) = 0 Then 
          ' This NextDate hits a holiday. 
          ' Subtract one day before adding one after the loop. 
          Days = Days - Sign 
          Exit For 
         End If 
        Next 
        On Error GoTo 0 
        Days = Days + Sign 
      End Select 
     Loop 
    End If 

    DateAddWorkdays = NextDate 

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 

' 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