日付のギャップの長さの指定日付のリスト

Question

日付のリストを検索し、日付のギャップがどれくらいあるかを識別するスクリプトを作成しようとしています。私は、エラーを受信して​​いないんだけど、マクロが正常に動作していない

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 

：私はVBAに新たなんだ、これは完全に間違っているかもしれないが、ここでは、いくつかのサイトを参照した後、私が思い付いたものです。今すぐ戻ってくるのは、戻ってくるのは-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