David,
Thanks again. Found a few typos in the code below...
Should be End Select, not End If.
Should be >0 and <0 in the case statements, otherwise it's forever in a loop. And the last one is you left out the vbTextCompare in the the StrComp function. Fixing all these gets me the following code:
----------------CODE-------------------
Function BinarySearch(strArray() As String, strSearch As String) As Long
Dim lngIndex As Long
Dim lngFirst As Long
Dim lngLast As Long
Dim lngMiddle As Long
Dim bolInverseOrder As Integer
lngFirst = LBound(strArray)
lngLast = UBound(strArray)
bolInverseOrder = (strArray(lngFirst) > strArray(lngLast))
BinarySearch = lngFirst - 1
Do
lngMiddle = (lngFirst + lngLast) \ 2
Select Case StrComp(strArray(lngMiddle), strSearch, vbTextCompare)
Case 0
BinarySearch = lngMiddle
Exit Do
Case Is < 0
lngFirst = lngMiddle + 1
Case Is > 0
lngLast = lngMiddle - 1
End Select
Loop Until lngFirst > lngLast
End Function
--------------------END CODE---------------------
This is fast and gives me the answer of 85 numbers missing.
Thanks again.
Scott B)
--- In ExcelVBA@yahoogroups.com, "david braithwaite" <dbraithwaite@...> wrote:
>
> Scott
>
>
>
> Glad the initial thing worked for you.. It is the key.
>
> I the Select solution I gave had a bug when I typed it in
>
> (should have copy/pasted it)
>
> The following does work and is a c/paste.
>
>
>
> Do
>
> lngMiddle = (lngFirst + lngLast) \ 2
>
> Select Case StrComp(strArray(lngMiddle), strSearch)
>
> Case 0
>
> BinarySearch = lngMiddle
>
> Exit Do
>
> Case Is < 1
>
> lngFirst = lngMiddle + 1
>
> Case Is > 1
>
> lngLast = lngMiddle - 1
>
> End If
>
> Loop Until lngFirst > lngLast
>
>
>
> David
>
>
>
>
>
> [Non-text portions of this message have been removed]
>
Be sure to check out TechTrax Ezine for many, free Excel VBA articles! Go here: http://www.mousetrax.com/techtrax to enter the ezine, then search the ARCHIVES for EXCEL VBA.
----------------------------------
Visit our ExcelVBA group home page for more info and support files:
http://groups.yahoo.com/group/ExcelVBA
----------------------------------
More free tutorials and resources available at:
http://www.mousetrax.com
----------------------------------
Tidak ada komentar:
Posting Komentar