Question

我想比较日期以找到重叠的日期。

我创建的第一个函数检查完全重叠，部分重叠或没有重叠。

这是第二个功能。它将用于扩展部分重叠过程，比较实际重叠的内容，并提供重叠范围之间的日期序列，或创建带有短划线的第一个日期和重叠的最后日期。

我到目前为止的代码：

Public Function partialdates(SD1 As Integer, ED1 As Integer, SD2 As Integer, ED2 As Integer) As String

'This function will be expanded, but the first If statement takes 1 case such that the first set of dates overlaps, but not beginning with the start date: SD1 = 1885 ED1 = 1969, SD2 = 1897 ED2 = 1972

    Dim i As Integer 
    Dim years As Integer
    Dim difference As Integer

    If SD1 < SD2 And SD1 <= ED2 And ED1 <= ED2 And ED1 >= SD2 Then
        difference = ED1 - SD2
        For i = 1 To difference

' I need help with this, to create a sequence of years that will be what are 
' overlapped, such as 1897, 1898, 1899...etc

            years = years & ", " + 1           
        Next
        partialdates = years
    End If
End Function

Answer 1

用以下行替换函数体：

Dim i As Integer
Dim difference As Integer

If SD1 < SD2 And SD1 <= ED2 And ED1 <= ED2 And ED1 >= SD2 Then
    difference = ED1 - SD2
    partialdates = ""
    For i = 1 To difference

' I need help with this, to create a sequence of years that will be what are
' overlapped, such as 1897, 1898, 1899...etc

        partialdates = partialdates & IIf(partialdates = "", "", ", ") & (SD2 + i)
    Next
End If

Answer 2

我有一个非常糟糕的vb，我曾经用它来筛选日期并找到重叠的日期。我只是分享这个 - 它没有直接回答你的问题，但可能会让你知道从哪里开始？我将所有开始和结束日期存储到数组中，然后以这种方式查看它。我通过将每个重叠存储在（0,0）维的数组中来找到最大的重叠（如果您希望存储所有日期，则可以更改此值）。它也真的只有在数组有序的情况下才有效。如果我现在需要这个，我只会将所有日期转储到访问表中，然后查询，这样列表的顺序就不重要了。或者我可以在vba中重写它来做同样的事情

            Dim ChkArray(0,0) as date

            For l = LBound(UACFArray, 1) To UBound(UACFArray, 1)
                For m = LBound(UACFArray, 2) To UBound(UACFArray, 2)

                Select Case StartDate

                    Case Is = UACFArray(l, 0)
                        EndDate = UACFArray(l, m)

                    Case Is <> UACFArray(l, 0)

                        If StartDate > UACFArray(l, 0) And StartDate < UACFArray(l, m) Then
                            For c = LBound(ChkArray, 1) To UBound(ChkArray, 1)

                                ChkArray(c, 0) = UACFArray(l, 0)
                                ChkArray(c, 1) = UACFArray(l, m)

                            Next c

                        End If
                End Select

                Next m
            Next l

Answer 3

我本质上懒于收集值数组作为字符串，所以我通常只使用Scripting.Dictionary，然后在完成后加入键：

Public Function partialdates(SD1 As Integer, ED1 As Integer, SD2 As Integer, ED2 As Integer) As String
    If SD1 < SD2 And SD1 <= ED2 And ED1 <= ED2 And ED1 >= SD2 Then
        Dim difference As Integer
        difference = ED1 - SD2

        Dim years As Integer
        years = SD2
        With CreateObject("Scripting.Dictionary")
            Dim i As Integer
            For i = 1 To difference
                .Add years, vbNull
                years = years + 1
            Next
            partialdates = Join(.Keys, ", ")
        End With
    End If
End Function

循环连接每个值以放入一个单元格的值

3 个答案: