MS ACCESS VBA、就業日は以下のとおりです。休日休暇の週末

Question

MSDN機能を使用して就業日を計算すると、日付の書式設定に問題があるため、祝日数の問題が見つかりました。

計算は正しいですが、休日が営業日の場合のみです。それが土曜日や日曜日に行われている場合は、それを差し引いて偽の結果を生成します。 平日のためillustration of a false reading

機能に：

Public Function Workdays(ByRef startDate As Date, ByRef endDate As Date, Optional ByRef strHolidays As String = "Holidays") As Integer 
On Error GoTo Workdays_Error 
Dim nWeekdays, nHolidays As Integer 
Dim strWhere As String 

startDate = DateValue(startDate) 
endDate = DateValue(endDate) 
nWeekdays = Weekdays(startDate, endDate) 

If nWeekdays = -1 Then 
    Workdays = -1 
    GoTo Workdays_Exit 
End If 

strWhere = "[Holiday] >= #" & Format(startDate, "yyyy\/mm\/dd") & "# AND [Holiday] <= #" & Format(endDate, "yyyy\/mm\/dd") & "#" 
nHolidays = DCount(Expr:="[Holiday]", Domain:=strHolidays, Criteria:=strWhere) 
Workdays = nWeekdays - nHolidays 

Workdays_Exit: 
    Exit Function 
    Resume Workdays_Exit 

End Function 

そしてここでは、平日を計算する関数です：

Public Function Weekdays(ByRef startDate As Date, ByRef endDate As Date) As Integer 
' Returns the number of weekdays in the period from startDate 
' to endDate inclusive. Returns -1 if an error occurs. 

On Error GoTo Weekdays_Error 
Const ncNumberOfWeekendDays As Integer = 2 'The number of weekend days per week. 
Dim varDays As Variant     'The number of days inclusive. 
Dim varWeekendDays As Variant  'The number of weekend days. 
Dim dtmX As Date       'Temporary storage for datetime. 

' If the end date is earlier, swap the dates. 
If endDate < startDate Then 
    dtmX = startDate 
    startDate = endDate 
    endDate = dtmX 
End If 

' Calculate the number of days inclusive (+ 1 is to add back startDate). 
varDays = DateDiff(Interval:="d", date1:=startDate, date2:=endDate) + 1 

' Calculate the number of weekend days. 
varWeekendDays = (DateDiff(Interval:="ww", date1:=startDate, date2:=endDate) _ 
    * ncNumberOfWeekendDays) + IIf(DatePart(Interval:="w", _ 
    Date:=startDate) = vbSunday, 1, 0) + IIf(DatePart(Interval:="w", Date:=endDate) = vbSaturday, 1, 0) 

' Calculate the number of weekdays. 
Weekdays = (varDays - varWeekendDays) 

Weekdays_Exit: 
    Exit Function 

Weekdays_Error: 
    Weekdays = -1 
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Weekdays" 
    Resume Weekdays_Exit 

= 7 休日= 1または休日場合は休日を無視する方法を教えてくださいさらに、長期間に渡って、週末に落ちる、または休むことがある複数の休日がある可能性があります。

Answer 1

あなたのコードを掘り下げずに、週末に休暇を取る休日をカウントすることをお勧めします。そうでなければ正しく計算された（私が推測する）合計からその合計を差し引いて、週末の祝日を考慮して適切な調整を行うべきです。

Answer 2

以下の機能を使用して、2つの日付間の就業日数（祝日を除く）を取得することができます。

それは、tbHolidays祝日を保持している_DATEという名前の単一のフィールドで指定したテーブルが必要です。

Public Function WorkingDaysInDateRange(ByVal DateFrom As Date, _ 
             ByVal DateTo As Date, _ 
             Optional ByVal includeStartDate As Long = 0) As Long 
    On Error GoTo ErrorTrap 

    'Calculate the number of days 
    Dim lngTotalDays As Long 
     lngTotalDays = DateDiff("y", DateFrom, DateTo) + includeStartDate 

    'Calculate the number of weekend days. 
    Dim lngWeekendDays As Long 
     lngWeekendDays = (DateDiff("ww", DateFrom, DateTo) * 2) + _ 
          IIf(DatePart("w", DateFrom) = vbSunday, 1, 0) + _ 
          IIf(DatePart("w", DateTo) = vbSaturday, 1, 0) 

    'Get Non working days count from tbHolidays excluding weekends 
    Dim lngHolidays As Long 
     lngHolidays = DCount("[_Date]", "tbHolidays", _ 
          StringFormat("[_Date] Between #{0}# AND #{1}# AND Weekday([_Date]) Not In ({2}, {3})", Format(DateFrom, "mm/dd/yyyy"), _ 
                                Format(DateTo, "mm/dd/yyyy"), _ 
                                vbSaturday, vbSunday)) 
    Dim lngWrkDays As Long 
     lngWrkDays = lngTotalDays - (lngWeekendDays + lngHolidays) 

    'Return 
    WorkingDaysInDateRange = lngWrkDays 

Leave: 
    On Error GoTo 0 
    Exit Function 

ErrorTrap: 
    MsgBox Err.Description, vbCritical 
    Resume Leave 
End Function 

---

ヘルパーStringFormat機能：

Public Function StringFormat(ByVal Item As String, ParamArray args() As Variant) As String 

    Dim idx As Long 
    For idx = LBound(args) To UBound(args) 
     Item = Replace(Item, "{" & idx & "}", args(idx)) 
    Next idx 

    StringFormat = Item 
End Function 

Answer 3

それはループにちょうど日付はるかに簡単であるとカウント：

Public Function DateDiffWorkdays(_ 
    ByVal datDate1 As Date, _ 
    ByVal datDate2 As Date, _ 
    Optional ByVal booWorkOnHolidays As Boolean) _ 
    As Long 

' Calculates the count of workdays between datDate1 and datDate2. 
' 2014-10-03. Cactus Data ApS, CPH 

    Dim aHolidays() As Date 

    Dim lngDiff  As Long 
    Dim lngSign  As Long 
    Dim lngHoliday As Long 

    lngSign = Sgn(DateDiff("d", datDate1, datDate2)) 
    If lngSign <> 0 Then 
     If booWorkOnHolidays = True Then 
      ' Holidays are workdays. 
     Else 
      ' Retrieve array with holidays between datDate1 and datDate2. 
      aHolidays = GetHolidays(datDate1, datDate2) 
     End If 

     Do Until DateDiff("d", datDate1, datDate2) = 0 
      Select Case Weekday(datDate1) 
       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 datDate1 and datDate2. 
         ElseIf DateDiff("d", datDate1, aHolidays(lngHoliday)) = 0 Then 
          ' This datDate1 hits a holiday. 
          ' Subtract one day before adding one after the loop. 
          lngDiff = lngDiff - lngSign 
          Exit For 
         End If 
        Next 
        On Error GoTo 0 
        lngDiff = lngDiff + lngSign 
      End Select 
      datDate1 = DateAdd("d", lngSign, datDate1) 
     Loop 
    End If 

    DateDiffWorkdays = lngDiff 

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