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

Question

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

如果有人可以提供帮助。

Answer 1

这是一个替代 VBA 函数，用于计算两个日期之间的工作日。通过“替代”，我同意 June7 的观点，包括许多代码示例在内的其他地方已经解决了这个问题。但是，在我的测试中，下面的代码比the link 中的函数快4 倍以上。当从大型数据集的查询中调用时，这种速度差异非常显着。此外，我的代码为逆序日期参数以及开始或结束日期在周末时产生一致的结果。其他代码，包括那些在 cmets 中链接的代码，没有表现出以下所有内容：

• 在指定范围内没有工作日（同一周末）时的唯一值。
• 当第一个日期在第二个日期之前返回负天数来处理反向日期顺序。
• 始终返回已交换日期订单的负数，从而与反向日期订单保持一致。
• 与周末结束或开始的日期范围保持一致。其他功能有时会计算进入或离开周末的 +1，但在整个周末进行时没有这样的额外 +1。此外，对于其他功能，周末开始与结束之间可能存在不一致。

WorkdayDiff 函数的返回值：

• 对于 d1
• 对于 d1 > d2，返回一个负数。对于只有正数值，可以将最后一行代码更改为WorkdayDiff = (diff + 1)，或者可以使用Abs() 包装对函数的调用。
  • WorkdayDiff(d1, d2) == - WorkdayDiff(d2, d1)
• 如果两个日期都在同一个周末，则该函数返回 0。

为了方便负数和特殊的 0 返回值而不引发越界日期错误，该函数的行为必须类似于 DateDiff(...) ±1 对于典型工作日。例如。 WorkdayDiff(Date, Date) 返回 1 而不是 DateDiff("d", Date, Date) 那样的 0。

（顺便说一句，问题文本中的数字不一致，因此不清楚预期/期望哪种行为。关键是您可能需要检查 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

要解决假期问题，可以对假期表执行一个简单的查询。我的建议是，无论假期是否在周末，都已经标记了表格（带有布尔字段），或者完全排除周末假期以提高速度。否则，下面的查询将为您选择仅限工作日的假期。这假设单个表 [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