Перекрытие дат: обобщенный способ разделения дат, чтобы получить интервал перекрытия? - PullRequest
2 голосов
/ 10 марта 2020

Предположим, у нас есть два интервала дат:

A-------------B
       C-------------------------D

Где A и C - начальные даты, а B и D - даты окончания интервалов дат AB и CD.

Я обнаружил, что если (B+D)>=(A+C), то у нас совпадает дата. Но если (B+D)<(A+C), у нас нет перекрытия даты.

То, что я искал, но безуспешно, это выяснить обобщенный алгоритм, который возвращает мне разбитый набор интервала даты AB. В приведенном выше случае разделенный набор AB будет выглядеть следующим образом:

A----------(C-1) 'I mean, begining date of interval CD diminished by one day
C----------B     'The actual date overlapping

Я не ищу алгоритм, который проверяет каждый возможный случай, а обобщенный алгоритм, применимый к любому случаю.

Этот алгоритм существует? Я действительно ценю любую помощь !!!

Все случаи, которые я могу выяснить, (но я не уверен, что это другие):

A---------------B
    C--------------------D

             A---------------B
C--------------------D

A---------------B
    C------D

    A------B
C---------------D

A---------------B
C---------------D

      A--------B
C--------------D

A--------------B
     C---------D

A--------------B
C-------D

A-------B
C--------------D

РЕДАКТИРОВАТЬ

Основываясь на блестяще выбранном ответе ученика Гэри, я смог выяснить свою необходимую функцию следующим образом. Мне не нужно знать, какой из интервалов внутри разделенного набора результирующих инверсий является перекрывающимся, но с некоторыми изменениями в функции это легко достигается.

Sub Test()
arr = fSplitOverlap( _
DateSerial(2020, 3, 1), DateSerial(2020, 3, 31), _
DateSerial(2020, 3, 1), DateSerial(2020, 3, 10))
For i = LBound(arr) To UBound(arr) Step 2
    Debug.Print arr(i), arr(i + 1)
Next i
End Sub


Function fSplitOverlap(ByVal Di1 As Date, ByVal Df1 As Date, _
ByVal Di2 As Date, ByVal Df2 As Date) As Variant

Dim arr() As Date

Dim DiOver As Date, DfOver As Date
Dim HaveFirsDisjoint1 As Boolean: HaveFirsDisjoint1 = False
DiOver = Application.WorksheetFunction.Max(Di1, Di2)
DfOver = Application.WorksheetFunction.Min(Df1, Df2)

'TEST OVERLAP
If DateDiff("d", DiOver, DfOver) >= 0 Then

    'TEST FIRST POSSIBLE DISJOINT INVERVAL
    If DateDiff("d", Di1, DateAdd("d", -1, DiOver)) >= 0 Then
        ReDim Preserve arr(1 To 4)
        arr(1) = Di1
        arr(2) = DateAdd("d", -1, DiOver)
        arr(3) = DiOver
        arr(4) = DfOver
        HaveFirsDisjoint1 = True
    End If

    'TEST SECOND POSSIBLE DISJOINT INVERVAL
    If DateDiff("d", DateAdd("d", 1, DfOver), Df1) >= 0 Then
        If HaveFirsDisjoint1 = True Then
            ReDim Preserve arr(1 To 6)
            arr(1) = Di1
            arr(2) = DateAdd("d", -1, DiOver)
            arr(3) = DiOver
            arr(4) = DfOver
            arr(5) = DateAdd("d", 1, DfOver)
            arr(6) = Df1
        Else
            ReDim Preserve arr(1 To 4)
            arr(1) = DiOver
            arr(2) = DfOver
            arr(3) = DateAdd("d", 1, DfOver)
            arr(4) = Df1
        End If
    End If

End If

fSplitOverlap = arr

End Function

1 Ответ

1 голос
/ 10 марта 2020

Как видно из ваших фотографий, если A> D или C> B , то регионы не пересекаются

В противном случае перекрытие будет MIN(B,D) - MAX(A,C) + 1

Итак, в VBA:

Sub Overlap()
    Dim A As Date, B As Date, C As Date, D As Date

    A = DateValue("1/11/2020")
    B = DateValue("1/20/2020")
    C = DateValue("1/15/2020")
    D = DateValue("2/13/2020")

    If A > D Or C > B Then
        MsgBox "no overlap"
        Exit Sub
    End If
    With Application.WorksheetFunction
        MsgBox .Min(B, D) - .Max(A, C) + 1
    End With
End Sub

Здесь перекрытие:

  1. 1/15
  2. 1/16
  3. 1/17
  4. 1/18
  5. 1/19
  6. 1/20
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...