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

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 

我没有收到一个错误，但宏无法正常工作。现在，它应该返回15时返回-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