Andaba buscando la manera de buscar en un Array de la forma mas RAPIDA posible y bueno, recordando el QuickSort arme este algoritmo que busca en un Array ordenado de forma Ascendente o Desendente un valor en el mismo lo hace de forma Extremadamente rapida...
Se lo dejo en Dos versiones... Recursiva y con un Do... Loop
Aqui se los dejo:
Forma Recursiva (Gasta memoria...)
Código
' ' ///////////////////////////////////////////////////////////// ' // // ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' ///////////////////////////////////////////////////////////// option explicit 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 vBuff&(lng_Ub) > vBuff&(lng_lb) Then ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p) Else ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p) End If End Function Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean Select Case vValue Case vBuff&(l&) p& = l& ExitsInArrayR = True Case vBuff&(u&) p& = u& ExitsInArrayR = True Case Else p = (l& + u&) / 2 If p <> l& And p& <> u& Then If vBuff&(p&) < vValue& Then ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p) ElseIf vBuff&(p&) > vValue& Then ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p) ElseIf vBuff&(p&) = vValue& Then ExitsInArrayR = True End If End If End Select End Function
Forma con Do ... Loop
Código
' ' ///////////////////////////////////////////////////////////// ' // // ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' ///////////////////////////////////////////////////////////// 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
Prueba de Velocidad en comparacion a un Simple For Next...
Código
' ' ///////////////////////////////////////////////////////////// ' // // ' // Autor: BlackZeroX ( Ortega Avila Miguel Angel ) // ' // // ' // Web: http://InfrAngeluX.Sytes.Net/ // ' // // ' // |-> Pueden Distribuir Este Codigo siempre y cuando // ' // no se eliminen los creditos originales de este codigo // ' // No importando que sea modificado/editado o engrandesido // ' // o achicado, si es en base a este codigo // ' ///////////////////////////////////////////////////////////// Option Explicit Private Declare Function GetTickCount Lib "kernel32" () As Long Private Sub Form_Load() Dim vBuff&(0 To 99999) Dim i&, p& Dim l& Dim vStr$ For i& = LBound(vBuff&()) To UBound(vBuff&()) vBuff(i&) = (99999 * 3) - (i * 3) Next i& l& = GetTickCount() For i& = LBound(vBuff&()) To 999 Call ExitsInArrayLento(i&, vBuff&(), p&) Next i& vStr$ = GetTickCount - l& l& = GetTickCount() For i& = LBound(vBuff&()) To 999 ' // ExitsInArrayNR es un poquito mas rapido... que ExitsInArray Call ExitsInArray(i&, vBuff&(), p&) Next i& l& = GetTickCount - l& MsgBox "ExitsInArrayLento " & vStr$ & vbCrLf & _ "ExitsInArray " & l 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 vBuff&(lng_Ub) > vBuff&(lng_lb) Then ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_lb, lng_Ub, p) Else ExitsInArray = ExitsInArrayR(vValue, vBuff&, lng_Ub, lng_lb, p) End If End Function Public Function ExitsInArrayR(ByRef vValue As Long, ByRef vBuff() As Long, ByVal l As Long, ByVal u As Long, ByRef p As Long) As Boolean Select Case vValue Case vBuff&(l&) p& = l& ExitsInArrayR = True Case vBuff&(u&) p& = u& ExitsInArrayR = True Case Else p = (l& + u&) / 2 If p <> l& And p& <> u& Then If vBuff&(p&) < vValue& Then ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), p, u, p) ElseIf vBuff&(p&) > vValue& Then ExitsInArrayR = ExitsInArrayR(vValue, vBuff&(), l, p, p) ElseIf vBuff&(p&) = vValue& Then ExitsInArrayR = True End If End If End Select End Function 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 Private Function ExitsInArrayLento(ByRef Value As Long, ByRef ArrayCollection() As Long, Optional ByRef OutInIndex As Long) As Boolean For OutInIndex = LBound(ArrayCollection) To UBound(ArrayCollection) If ArrayCollection(OutInIndex) = Value Then ExitsInArrayLento = True Exit Function End If Next End Function
Temibles Lunas!¡.
.