AW: Sortiertes Array durchsuchen
26.04.2015 17:37:49
Nepumuk
Hallo,
Oooooooooooooooops !!!!!
So besser?
Option Explicit
Private llngFound As Long, llngEnd As Long
Public Sub Test()
Dim adtmArray(364) As Date, ialngIndex As Long
For ialngIndex = LBound(adtmArray) To UBound(adtmArray)
adtmArray(ialngIndex) = DateSerial(Year(Date), 1, ialngIndex + 1)
Next
llngEnd = LBound(adtmArray) - 1
Call Search(adtmArray, DateSerial(2015, 12, 31), LBound(adtmArray) - 1, UBound(adtmArray) + 1, 0)
If llngFound = llngEnd Then
MsgBox "Nix gefunden.", vbExclamation, "Hinweis"
Else
MsgBox CStr(adtmArray(llngFound)) & " an Position " & CStr(llngFound), vbInformation, "Info"
End If
End Sub
Private Sub Search( _
ByRef pradtmArray() As Date, _
ByVal pvdtmSearch As Date, _
ByVal pvlngLBound As Long, _
ByVal pvlngUbound As Long, _
ByRef prlngLastIndex As Long)
Dim lngNewIndex As Long
lngNewIndex = (pvlngLBound + pvlngUbound) \ 2
If lngNewIndex = prlngLastIndex Then
llngFound = llngEnd
ElseIf pradtmArray(lngNewIndex) = pvdtmSearch Then
llngFound = lngNewIndex
ElseIf pradtmArray(lngNewIndex) > pvdtmSearch Then
Call Search(pradtmArray(), pvdtmSearch, pvlngLBound, lngNewIndex, lngNewIndex)
ElseIf pradtmArray(lngNewIndex) < pvdtmSearch Then
Call Search(pradtmArray(), pvdtmSearch, lngNewIndex, pvlngUbound, lngNewIndex)
End If
End Sub
Gruß
Nepumuk