我正在尝试编写一个搜索日期列表的脚本,并确定日期差距有多长。我是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.任何帮助都将非常感激!
以下是数据的屏幕截图,应该选择单独的日期差距。
答案 0 :(得分:0)
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
答案 1 :(得分:0)
查看我的日历,我相信您的预期结果实际上应该是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