I've renamed the function and parameters. The function returns the result rather than having a ByRef
parameter. I've used a collection to store the row indexes.
Function GetDatePositions(ByRef database() As Variant, ByVal searchDate As Date) As Long()
Const colDates As Long = 1 'the index of the column holding dates
Dim i As Long
Dim collRowIndexes As New Collection
For i = LBound(database, 1) To UBound(database, 1)
If database(i, colDates) = searchDate Then
collRowIndexes.Add i
End If
Next i
If collRowIndexes.Count = 0 Then
GetDatePositions = GetDatePositions(database, searchDate + 1)
Exit Function
End If
Dim res() As Long
ReDim res(0 To collRowIndexes.Count - 1)
Dim v As Variant
i = 0
For Each v In collRowIndexes
res(i) = v
i = i + 1
Next v
GetDatePositions = res
End Function
EDIT
There is no need to search each consecutive date. We just need to keep track of the next date that is bigger than the search date.
Function GetDatePositions(ByRef database() As Variant, ByVal searchDate As Date) As Long()
Const colDates As Long = 1 'the index of the column holding dates
Dim i As Long
Dim collRowIndexes As New Collection
Dim dateFound As Boolean
Dim nextDate As Date
Dim tempDate As Date
dateFound = False
For i = LBound(database, 1) To UBound(database, 1)
tempDate = database(i, colDates)
If tempDate = searchDate Then
dateFound = True
collRowIndexes.Add i
Else
If Not dateFound Then
If searchDate < tempDate Then
If nextDate = 0 Then
nextDate = tempDate
ElseIf tempDate < nextDate Then
nextDate = tempDate
End If
End If
End If
End If
Next i
'
If collRowIndexes.Count = 0 Then
If nextDate = 0 Then
Err.Raise 5, "GetDatePositions", "No date found"
Else
GetDatePositions = GetDatePositions(database, nextDate)
Exit Function
End If
End If
Dim res() As Long
ReDim res(0 To collRowIndexes.Count - 1)
Dim v As Variant
i = 0
For Each v In collRowIndexes
res(i) = v
i = i + 1
Next v
GetDatePositions = res
End Function
Obviously, an assumption that all dates are rounded is made. But if dates also contain time (hours, minutes, seconds) then tempDate = database(i, colDates)
needs to be replaced with tempDate = VBA.Int(database(i, colDates))
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…