Question

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

如果有人可以提供协助。

Answer 1

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

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

返回WorkdayDiff函数的值：

对于d1＆lt; = d2，它返回给定范围内的工作日总数，包括在内。
对于d1> d2，返回一个负数。对于仅正值，最后一行代码可以更改为WorkdayDiff = (diff + 1)，或者可以使用Abs()包含对函数的调用。
- WorkdayDiff（d1，d2）== - WorkdayDiff（d2，d1）
如果两个日期都在同一个周末，则该函数返回0。

为了便于使用负数和特殊0返回值而不为越界日期抛出错误，对于典型的工作日，该函数必须表现得像DateDiff（...）±1。例如。 WorkdayDiff(Date, Date)会DateDiff("d", Date, Date)返回1而不是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

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

1 个答案: