[Src] IsInArray

[Psyke1]

Bueno, aquí os dejo esta sencilla función.
Su finalidad es devolver el Index de un Item que se encuentre en un array ordenado (acepta todo tipo de Arrays : String, Double, Long...), con la opción de devolver el primero que se encuentre en el array y con los parámetros lngStart y lngEnd podemos establecer límites en nuestra búsqueda.  
Para ordenarlo aconsejo usar esta maravillosa función que hizo mi amigo BlackZer0x :
http://goo.gl/RG4Bx

Código: (vb) [Seleccionar]

Option Explicit
'======================================================================
' º Function  : IsInArray
' º Author    : Psyke1
' º Country   : Spain
' º Mail      : vbpsyke1@mixmail.com
' º Date      : 09/05/2011
' º Twitter   : http://twitter.com/#!/PsYkE1
' º Dedicated : BlackZer0x
' º Reference : http://goo.gl/RDQhK
' º Recommended Websites :
'       http://foro.h-sec.org
'       http://www.frogcheat.com.ar
'       http://InfrAngeluX.Sytes.Net
'======================================================================
Public Static Function IsInArray&(varArr, varValue, Optional lngStart&, Optional lngEnd&, Optional bolFindFirst As Boolean)
Dim lngLB&, lngUB&, Q&, C&
    If IsArray(varArr) Then
        lngLB = LBound(varArr)
        lngUB = UBound(varArr)
        
        If Not IsMissing(lngStart) Then
           If (lngStart > lngLB) And (lngStart < lngUB) Then lngLB = lngStart
        End If
        If Not IsMissing(lngEnd) Then
           If (lngEnd > lngLB) And (lngEnd < lngUB) Then lngUB = lngEnd
        End If
        
        If varArr(lngLB) = varValue Then
            IsInArray = lngLB
            Exit Function
        ElseIf varArr(lngUB) = varValue Then
            If bolFindFirst Then
                Do While (varArr(lngUB) = varArr(lngUB - 1)) And (Q > lngLB)
                    lngUB = lngUB - 1
                Loop
            End If
            IsInArray = lngUB
            Exit Function
        End If
        
        If lngUB - lngLB < 2 Then GoTo NotFound
        If (varArr(lngLB) > varValue) Or (varArr(lngUB) < varValue) Then GoTo NotFound
        
        C = 0
        Do
            Q = (lngUB + lngLB) \ 2
            If C = Q Then GoTo NotFound

            If varArr(Q) > varValue Then
                lngUB = Q
            ElseIf varArr(Q) < varValue Then
                lngLB = Q
                C = lngLB
            Else
                If bolFindFirst Then
                    Do While (varArr(Q) = varArr(Q - 1)) And (Q > lngLB)
                        Q = Q - 1
                    Loop
                End If
                IsInArray = Q
                Exit Function
            End If
        Loop
    End If
Exit Function

NotFound:
    IsInArray = -1
End Function
Un ejemplo:

Código: (vb) [Seleccionar]

Option Explicit

Private Const strLine$ = "------------------------------"

Private Sub Form_Load()
Dim L&(60), S(), Q&

    For Q = 0 To 60
        L(Q) = Q * 2
    Next Q

    Debug.Print strLine$, Time$, strLine$
    Debug.Print IsInArray(L, 15)                '---> -1
    Debug.Print IsInArray(L, 40)                '--->  20
    Debug.Print IsInArray(L, 85)                '---> -1
    Debug.Print IsInArray(L, 100)               '--->  50

    S = Array("abba", "acero", "karcrack", "sereno", "silencio", "tonto", "tonto", "tonto", "tonto", "zalme")

    Debug.Print strLine$
    Debug.Print IsInArray(S, "zalme")           '--->  9
    Debug.Print IsInArray(S, "zalme", , 4)      '---> -1
    Debug.Print IsInArray(S, "mesa")            '---> -1
    Debug.Print IsInArray(S, "besos")           '---> -1
    Debug.Print IsInArray(S, "karcrack")        '--->  2
    Debug.Print IsInArray(S, "karcrack", 3)     '---> -1
    Debug.Print IsInArray(S, "tonto")           '--->  6
    Debug.Print IsInArray(S, "tonto", , , True) '--->  5
End Sub
Retorna:

Código: [Seleccionar]

------------------------------            18:59:54      ------------------------------
-1
 20
-1
 50
------------------------------
 9
-1
-1
-1
 2
-1
 6
 5

Si necesitamos especial velocidad y lo queremos para un tipo de variable en concreto, sólo hay que modificar un par de cosas.
Aquí un ejemplo para buscar en un array Long, comparado con el código de BlackZer0x ( http://goo.gl/RDQhK ) :

Código: [Seleccionar]

Option Explicit
'// Compilado sin la comprobación de límites en los arrays xP

Private Sub Form_Load()
Dim L&(6000), Q&, t As New CTiming, y&
    
    If App.LogMode = 0 Then End
    
    For Q = 0 To 6000
        L(Q) = Q * 2
    Next Q
    
    Me.AutoRedraw = True
    
    t.Reset
    For Q = 1 To 1000
        IsInArray L, 15
        IsInArray L, 40
        IsInArray L, 2001
        IsInArray L, 5020
        IsInArray L, 12000
    Next Q
    Me.Print "IsInArray", , t.sElapsed
    
    t.Reset
    For Q = 1 To 1000
        ExitsInArrayNR 15, L, y
        ExitsInArrayNR 40, L, y
        ExitsInArrayNR 2001, L, y
        ExitsInArrayNR 5020, L, y
        ExitsInArrayNR 12000, L, y
    Next Q
    Me.Print "ExitsInArrayNR", t.sElapsed
End Sub

'// by Psyke1
Public Static Function IsInArray&(lngArr&(), lngValue&, Optional lngStart&, Optional lngEnd&, Optional bolFindFirst As Boolean)
Dim lngLB&, lngUB&, lngItem&, Q&, C&
    lngLB = LBound(lngArr)
    lngUB = UBound(lngArr)
    
    If Not IsMissing(lngStart) Then
       If (lngStart > lngLB) And (lngStart < lngUB) Then lngLB = lngStart
    End If
    If Not IsMissing(lngEnd) Then
       If (lngEnd > lngLB) And (lngEnd < lngUB) Then lngUB = lngEnd
    End If
    
    If lngArr(lngLB) = lngValue Then
        IsInArray = lngLB
        Exit Function
    ElseIf lngArr(lngUB) = lngValue Then
        If bolFindFirst Then
            Do While (lngArr(lngUB) = lngArr(lngUB - 1)) And (Q > lngLB)
                lngUB = lngUB - 1
            Loop
        End If
        IsInArray = lngUB
        Exit Function
    End If
    
    If lngUB - lngLB < 2 Then GoTo NotFound
    If (lngArr(lngLB) > lngValue) Or (lngArr(lngUB) < lngValue) Then GoTo NotFound
    
    C = 0
    Do
        Q = (lngUB + lngLB) \ 2
        If C = Q Then GoTo NotFound

        If lngArr(Q) > lngValue Then
            lngUB = Q
        ElseIf lngArr(Q) < lngValue Then
            lngLB = Q
            C = lngLB
        Else
            If bolFindFirst Then
                Do While (lngArr(Q) = lngArr(Q - 1)) And (Q > lngLB)
                    Q = Q - 1
                Loop
            End If
            IsInArray = Q
            Exit Function
        End If
    Loop
Exit Function

NotFound:
    IsInArray = -1
End Function

'// by BlackZer0x
Public Function ExitsInArrayNR(ByRef vValue As Long, ByRef vBuff() As Long, ByRef p As Long) As Boolean
Dim lng_lb                      As Long
Dim lng_Ub                      As Long
    lng_lb = LBound(vBuff&())
    lng_Ub = UBound(vBuff&())
    If Not vBuff&(lng_Ub) > vBuff&(lng_lb) Then
        Dim t                           As Long
        t = lng_Ub
        lng_Ub = lng_lb
        lng_lb = t
    End If
    Do Until ExitsInArrayNR
        Select Case vValue
            Case vBuff&(lng_lb&)
                p& = lng_lb&
                ExitsInArrayNR = True
            Case vBuff&(lng_Ub&)
                p& = lng_Ub&
                ExitsInArrayNR = True
            Case Else
                p = (lng_lb& + lng_Ub&) / 2
                If p <> lng_lb& And p& <> lng_Ub& Then
                    If vBuff&(p&) < vValue& Then
                        lng_lb = p
                    ElseIf vBuff&(p&) > vValue& Then
                        lng_Ub = p
                    ElseIf vBuff&(p&) = vValue& Then
                        ExitsInArrayNR = True
                    End If
                Else
                    Exit Do
                End If
        End Select
    Loop
End Function
Resultado:


DoEvents!

[ssccaann43]

Me gusta...! Buen trabajo Psyke...!

[coco]

che, ahi el numero "1,315" es 1315mS o 1,315mS (digo, porq el uso de la coma y del punto varia en muchos lados)

de todas formas, interesante para buscar datos!

saludos