在计算访问中两个日期的差异时排除周末

I am working on an access database for a project and need some help which I cannot solve. I have two date columns Actual Date and Delivery Date which are subtracted from to give a difference eg. Actual date can be 12/05/2017 and Delivery Date can be 16/05/17 subtracted the answer is 4, now my problem is I need to exclude weekends from the calculation, if the actual date is a Thursday and the Delivery Date is a Tuesday the difference should be 4 days and not 6 because the weekends shouldn't count. I need to implement this in Microsoft Access and have the difference show on a report.

我正在为一个项目的访问数据库工作,需要一些我无法解决的帮助。我有两个日期列实际日期和交货日期,从中减去以给出差异,例如。实际日期可以是12/05/2017,交货日期可以是16/05/17减去答案是4,现在我的问题是我需要从计算中排除周末,如果实际日期是星期四,交货日期是星期二的差异应该是4天而不是6天,因为周末不应该算在内。我需要在Microsoft Access中实现这一点,并在报告中显示差异。

If anyone can assist.

如果有人可以提供帮助

1 个解决方案

#1

Here is an alternative VBA function to calculate workdays between two dates. By "alternative", I agree with June7 that this has been addressed elsewhere including many code samples. However, in my testing the following code is over 4 times faster than the function in the link. This speed difference is significant when called from queries of large datasets. Also, my code produces consistent results for reverse-order date parameters and when the start or end dates are on weekends. Other code, including those linked to in the comments, do not exhibit ALL of the following:

这是一个替代的VBA函数,用于计算两个日期之间的工作日。通过“替代”,我同意June7在其他地方已经解决了这个问题,包括许多代码示例。但是,在我的测试中,以下代码比链接中的函数快4倍。从大型数据集的查询调用时,此速度差异很大。此外,我的代码为逆序日期参数以及开始或结束日期是在周末时产生一致的结果。其他代码(包括在评论中链接的代码)不会显示以下所有内容:

• Unique value for case when there are NO weekdays (same weekend) in specified range.

在指定范围内没有工作日(同一个周末)的情况下的唯一值。

• Handles reverse date order by returning negative number of days when first date comes before second.

通过在第一个日期到达第二个日期之前返回负天数来处理反向日期顺序。

• Consistency with reverse date orders by always returning the negative of the swapped date order.

通过始终返回交换日期订单的负数来与反向日期订单保持一致。

• Consistency with date range ending or starting within a weekend. Other functions sometimes count +1 going into or coming out of the weekend, yet there is no such extra +1 when going over the entire weekend. Also, with other functions there may be inconsistencies between starting vs ending in the weekend.

与日期范围结束或在周末内开始的一致性。其他功能有时会计入+1进入或离开周末,但在整个周末都没有这样的额外+1。此外,对于其他功能,在周末开始与结束之间可能存在不一致。

Return values of WorkdayDiff function:

WorkdayDiff函数的返回值:

• For d1 <= d2, it returns the total number of weekdays in the given range, inclusive.

对于d1 <= d2,它返回给定范围内的工作日总数(包括)。

• For d1 > d2, returns a negative number. For only positive values, the last line of code can be changed to WorkdayDiff = (diff + 1) or the call to the function can be wrapped with Abs().
  • WorkdayDiff(d1, d2) == - WorkdayDiff(d2, d1)

  WorkdayDiff(d1,d2)== - WorkdayDiff(d2,d1)

对于d1> d2,返回负数。仅对于正值,最后一行代码可以更改为WorkdayDiff =(diff + 1),或者可以使用Abs()包装对函数的调用。 WorkdayDiff(d1,d2)== - WorkdayDiff(d2,d1)

• The function returns 0 if both dates fall on the same weekend.

如果两个日期都在同一个周末,则该函数返回0。

To facilitate both negative numbers and the special 0 return value without throwing errors for out-of-bound dates, the function must behave like DateDiff(...) ±1 for typical workdays. E.g. WorkdayDiff(Date, Date) returns 1 instead of 0 as DateDiff("d", Date, Date) does.

为了方便负数和特殊0返回值而不抛出越界日期的错误,对于典型的工作日,该函数必须表现得像DateDiff(...)±1。例如。 WorkDard(Date,Date)返回1而不是0,因为DateDiff(“d”,日期,日期)。

(Incidentally, the numbers in the question text are not consistent, so it's not clear which behavior is expected/desired. The point is that you may need to check for 0 and/or subtract 1 from the answer to get your desired result.)

(顺便提一下,问题文本中的数字不一致,因此不清楚预期/期望哪种行为。重点是您可能需要检查0和/或从答案中减去1以获得所需的结果。)

Public Function WorkdayDiff(ByVal d1 As Date, ByVal d2 As Date) As Long
  Dim diff As Long, sign As Long
  Dim wd1 As Integer, wd2 As Integer

  diff = DateDiff("d", d1, d2)
  If diff < 0 Then
    '* Effectively swap d1 and d2; reverse sign
    diff = -diff
    sign = -1
    wd1 = Weekday(d2)
  Else
    sign = 1
    wd1 = Weekday(d1)
  End If
  wd2 = (wd1 + diff - 1) Mod 7 + 1

  If (wd1 = 1 And diff = 0) Or (wd1 = 7 And diff <= 1) Then
    WorkdayDiff = 0 '* Both dates are on same weekend
    Exit Function
  End If

  '* If starting or ending date fall on weekend, shift to closest weekday
  '* since the weekends should not contribute to the sum.
  '* This shift is critical for the last If condition and arithmetic.
  If wd1 = 1 Then
    wd1 = 2 '* Shift to Monday
    diff = diff - 1
  ElseIf wd1 = 7 Then
    wd1 = 2 '* Shift to Monday
    diff = diff - 2
  End If

  If wd2 = 1 Then
    diff = diff - 2 '* Shift to Friday
  ElseIf wd2 = 7 Then
    diff = diff - 1 '* Shift to Friday
  End If

  '* If difference goes beyond weekend boundary then...
  If diff >= 7 - wd1 Then
    '* Normalize span to start on Monday for modulus arithmetic
    '* then remove weekend days
    diff = diff - ((diff + (wd1 - 2)) \ 7) * 2
  End If

  WorkdayDiff = sign * (diff + 1)
End Function

To address holidays, a single, simple query to a holiday table can be performed. My suggestion would be to have the table already flagged (with a boolean field) whether a holiday is on a weekend or not, or just exclude weekend holidays altogether to improve speed. Otherwise, the query below will select on weekday-only holidays for you. This assume a single table [Holidays] with a single field [holiday] where all values are for non-working days.

为了解决假期问题,可以执行对假日表的单个简单查询。我的建议是让表已经标记(带有布尔字段)假期是否在周末,或者只是排除周末假期以提高速度。否则,下面的查询将为您选择仅限工作日的假期。假设单个表[Holidays]具有单个字段[holiday],其中所有值都是非工作日。

Public Function WorkdayDiff2(ByVal d1 As Date, ByVal d2 As Date) As Long
  Dim diff As Long, sign As Long
  Dim wd1 As Integer, wd2 As Integer
  Dim holidays As Long
  Dim SQLRange As String

  diff = DateDiff("d", d1, d2)
  If diff < 0 Then
    '* Effectively swap d1 and d2; reverse sign
    diff = -diff
    sign = -1
    wd1 = Weekday(d2)
    SQLRange = "([holiday] >= #" & d2 & "# AND [holiday] <= #" & d1 & "#)"
  Else
    sign = 1
    wd1 = Weekday(d1)
    SQLRange = "([holiday] >= #" & d1 & "# AND [holiday] <= #" & d2 & "#)"
  End If
  wd2 = (wd1 + diff - 1) Mod 7 + 1

  If (wd1 = 1 And diff = 0) Or (wd1 = 7 And diff <= 1) Then
    WorkdayDiff2 = 0 '* Both dates are on same weekend
    Exit Function
  End If

  '* If starting or ending date fall on weekend, shift to closest weekday
  '* since the weekends should not contribute to the sum.
  '* This shift is critical for the last If condition and arithmetic.
  If wd1 = 1 Then
    wd1 = 2 '* Shift to Monday
    diff = diff - 1
  ElseIf wd1 = 7 Then
    wd1 = 2 '* Shift to Monday
    diff = diff - 2
  End If

  If wd2 = 1 Then
    diff = diff - 2 '* Shift to Friday
  ElseIf wd2 = 7 Then
    diff = diff - 1 '* Shift to Friday
  End If

  '* If difference goes beyond weekend boundary then...
  If diff >= 7 - wd1 Then
    '* Normalize span to start on Monday for modulus arithmetic
    '* then remove weekend days
    diff = diff - ((diff + (wd1 - 2)) \ 7) * 2
  End If

  '* For efficiency, it is recommended that this be set as a global or class-level
  '* variable and its value maintained between repetative calls as in a query.
  '* Otherwsie, it can be slow since retrieval of Currentdb is an expensive operation.
  Dim db As Database
  Set db = CurrentDb

  holidays = db.OpenRecordset( _
      "SELECT Count([holiday]) FROM [Holidays]" & _
      " WHERE Weekday([holiday]) Not In (1, 7) AND " & SQLRange, _
      dbOpenForwardOnly, dbReadOnly).Fields(0).Value

  WorkdayDiff2 = sign * (diff + 1 - holidays)
End Function