确定给定日期列表的日期差距

Question

我正在尝试编写一个搜索日期列表的脚本，并确定日期差距有多长。我是VBA的新手，这可能是完全错误的，但在引用了几个网站之后，我就提出了这个问题：

Sub IdentifyGaps()

Dim startdate As Date 'first date in column
Dim enddate As Date 'last date in column
Dim ust As Date 'first date of unemployment
Dim i As Long
ust = ActiveCell.Offset(1, 0).Value

With Sheet6
    startdate = [A1]
    enddate = .Cells(.Rows.Count, "A").End(xlUp).Value

    For i = startdate To enddate
        If ust <> DateAdd("d", 1, i) Then
            Sheet6.[C1].Value = DateDiff("d", i, ust)
        End If
    Next i
End With

End Sub

我没有收到错误，但宏无法正常工作。现在，当它应该返回时，它返回-43074.任何帮助都将非常感激！

以下是数据的屏幕截图，应该选择单独的日期差距。

Answer 1

Sub IdentifyGaps()

Dim ws As Worksheet
Dim Date1 As Long, Date2 As Long, Gap As Long, lRow As Long

Set ws = Sheet6
lRow = ws.Range("C" & Rows.Count).End(xlUp).Row

For x = 1 To ws.Range("A" & Rows.Count).End(xlUp).Row
    Date1 = ws.Cells(x, 1).Value
    Date2 = ws.Cells(x + 1, 1).Value
    Gap = DateDiff("d", Date1, Date2)
    If Gap > 1 Then
        ws.Range("C" & lRow).Value = Gap
        lRow = lRow + 1
    End If
Next x

Answer 2

查看我的日历，我相信您的预期结果实际上应该是17而不是15.此代码会将间隙值作为Long值返回，您可以使用该值执行任何操作。

'Reads a column of dates and returns the length of the first gap found
Function IdentifyGaps() As Long
    Dim StartDate As Date
    Dim EndDate As Date

    'This Variable is not needed for this solution, it is instead replaced by Gap
    'Dim ust As Date
    Dim Gap As Long

    'Read cell values into an array for more efficient operation
    Dim ReadArray() As Variant
    ReadArray = Sheet6.Range("A1").CurrentRegion

    Dim LastRow As Long
    LastRow = UBound(ReadArray, 1)

    StartDate = ReadArray(1, 1)
    EndDate = ReadArray(LastRow, 1)

    'ThisDate and PreviousDate are declared explicitly to highlight program flow
    Dim Row As Long
    Dim ThisDate As Date
    Dim PreviousDate As Date
    For Row = 2 To UBound(ReadArray, 1)
        ThisDate = ReadArray(Row, 1)
        PreviousDate = ReadArray(Row - 1, 1)
        Gap = ThisDate - PreviousDate
        If Gap > 1 Then Exit For
        Gap = 0
    Next Row

    IdentifyGaps = Gap
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ProveIt()
    Debug.Print IdentifyGaps
End Sub