.
De hecho solo saque la lógica de comparar
lpos, si se genera dos veces entonces se haría un bucle infinito que no tendría caso alguno, lo demás es lo mismo de mi código.
Solo reemplace las lineas sombreadas... aun que si quitaba la 2da linea entonces tendria que meter un rango de comparacion...
option explicit
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
Para que veas también quedaría con una simple modificación sin aplicar nada ni sacar nada de tu código (aun que a mi me gusto la lógica de comparar
lpos con su anterior valor); aun sigue siendo mas rápida que tu función con esta simple modificación...
option explicit
Private Sub SwapVals(ByRef lVal1 As Long, ByRef lval2 As Long)
lval2 = lval2 Xor lVal1
lVal1 = lVal1 Xor lval2
lval2 = lval2 Xor lVal1
End Sub
Public Function ExitsInArray(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
SwapVals lng_lb, lng_Ub
End If
Select Case vValue
Case vBuff&(lng_lb&)
p& = lng_lb&
ExitsInArray = True
Case vBuff&(lng_Ub&)
p& = lng_Ub&
ExitsInArray = True
Case Else
Do Until ExitsInArray
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
ExitsInArray = True
End If
Else
Exit Do
End If
Loop
End Select
End Function
por otro lado en tu código:
La variable
c debería espesar desde
lngLB ya que esta toma el valor desde
lngStart, aun que aun asi estaría bien pero bueno
no afecta en lo absoluto en nada.
No entiendo para que es el parámetro
bolFindStart deberías documentar un poco tu código (parámetros de entrada, trabajo de la función y resultados de la misma, mas no linea a linea)
Dulces Lunas!¡.