Question

我有以下问题

在2017年1月1日至2017年1月31日的特定范围内，以下范围事件发生了多少天？

实施例

1 range 1 Dec 2016 / 30 Jun 2017 = 31
2 range 1 Jan 2017 / 2 Jan 2017 = 2
3 range 4 Aug 2017 / 31 Aug 2017 = 0
4 range 24 Sep 2015 / 2 Jan 2017 = 2
5 range 6 Jan 2015 / 6 Feb 2016 = 0

您是否对access-VBA中的算法有所了解？

非常感谢

Answer 1

Public Function DaysInRange(vntRngStart As Date, vntRngEnd As Date, vntTestStart As Date, vntTestEnd As Date) As Integer
On Error GoTo PROC_ERR

    Dim vntOverlapStart As Date
    Dim vntOverlapEnd As Date

    If vntRngStart > vntRngEnd Then
        MsgBox "Main date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
        DaysInRange = -1
        Exit Function
    ElseIf vntTestStart > vntTestEnd Then
        MsgBox "Test date range is specified back-to-front, swap the dates and try again.", vbInformation, "Invalid input..."
        DaysInRange = -2
        Exit Function
    End If

    If vntTestEnd < vntRngStart Or vntTestStart > vntRngEnd Then
        'Either your test range ends before the given range starts,
        'or the test range starts after the end of the given range,
        'so there is no overlap between the two ranges.
        DaysInRange = 0
        Exit Function
    End If

    'So now we know that there must be some overlap
    If vntTestStart <= vntRngStart Then
        'Our test range starts before the start of the given range,
        'so the overlap starts at the beginning of the given range
        vntOverlapStart = vntRngStart
    Else
        'Our test range starts after the start of the given range,
        'so the overlap starts at the beginning of the test range
        vntOverlapStart = vntTestStart
    End If
    If vntTestEnd >= vntRngEnd Then
        'Our test range ends after the end of the given range,
        'so the overlap ends at the end of the given range
        vntOverlapEnd = vntRngEnd
    Else
        'Our test range ends after the end of the given range,
        'so the overlap ends at the end of the test range
        vntOverlapEnd = vntTestEnd
    End If
    DaysInRange = DateDiff("d", vntOverlapStart, vntOverlapEnd) + 1

PROC_EXIT:
    On Error Resume Next
    Exit Function

PROC_ERR:
    MsgBox "Error " & Err.Number & " in Function 'DaysInRange': " & Err.Description
    Resume PROC_EXIT

End Function

范围之间的天数计算

1 个答案: