Versión Lenta... Fue sacado del ListBoxEx de LeandroAscierto, con una modificación para pasar el array en la funcion.
Option Explicit
Public Enum EnuListOrder
AcendetOrder = 0
DecendentOrder = 1
End Enum
Public Sub Sorted(ByRef Item(), Optional Order As EnuListOrder = DecendentOrder)
Dim Itm As String
Dim J As Double
Dim i As Double
Dim mcount As Long
mcount = UBound(Item)
If Order = AcendetOrder Then
For J = 0 To mcount
For i = 0 To mcount
If Item(i) > Item(i + 1) Then
Itm = Item(i + 1)
Item(i + 1) = Item(i)
Item(i) = Itm
End If
Next i
Next J
Else
For J = 0 To mcount - 2
For i = 0 To mcount - 2
If Item(i) < Item(i + 1) Then
Itm = Item(i + 1)
Item(i + 1) = Item(i)
Item(i) = Itm
End If
Next i
Next J
End If
End Sub
El siguiente es una versión mejorada por un Servidor... ordena adecuadamente los numeros ( Antes 0, 1, 10, 100,1000, ahora 0,1,2,3,4,5 ), Es muchas veces mas rapido que el anterior y más largo el codigo...
'
' /////////////////////////////////////////////////////////////
' // Autor Algoritmo: C.A.R. Hoare en 1960 //
' // 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
Enum EnuListOrder
AcendetOrder = 0
DecendentOrder
End Enum
Private Sub AuxOrden(ByRef mArray(), _
i As Long, j As Long, _
il As Long, jl As Long)
Dim c As String
Dim c2 As Long
c = mArray(j)
mArray(j) = mArray(i)
mArray(i) = c
c2 = il
il = -jl
jl = -c2
End Sub
Private Sub PreSort(ByRef mArray(), lb As Long, ub As Long, _
k As Long, _
Optional Order As EnuListOrder = DecendentOrder)
Dim i As Long
Dim j As Long
Dim il As Long
Dim jl As Long
il = 0: jl = -1
i = lb: j = ub
While i < j
If Order = DecendentOrder Then
If IsNumeric(mArray(i)) And IsNumeric(mArray(j)) Then
If Val(mArray(i)) > Val(mArray(j)) Then
Call AuxOrden(mArray(), i, j, il, jl)
End If
Else
If mArray(i) > mArray(j) Then
Call AuxOrden(mArray(), i, j, il, jl)
End If
End If
Else
If IsNumeric(mArray(i)) And IsNumeric(mArray(j)) Then
If Val(mArray(i)) < Val(mArray(j)) Then
Call AuxOrden(mArray(), i, j, il, jl)
End If
Else
If mArray(i) < mArray(j) Then
Call AuxOrden(mArray(), i, j, il, jl)
End If
End If
End If
i = i + il
j = j + jl
Wend
k = i
End Sub
Private Sub QSort(ByRef mArray(), lb As Long, ub As Long, _
Optional Order As EnuListOrder = DecendentOrder)
Dim k As Long
If lb < ub Then
PreSort mArray, lb, ub, k, Order
Call QSort(mArray, lb, k - 1, Order)
Call QSort(mArray, k + 1, ub, Order)
End If
End Sub
Public Sub Start_QuickSort(ByRef mArray(), _
Optional Order As EnuListOrder = DecendentOrder)
If (Not (mArray)) = -1 Then Exit Sub ' Es para ver si esta inicializado el Arreglo
QSort mArray, LBound(mArray), UBound(mArray), DecendentOrder
End Sub
Ejemplo de Uso o llamda:
Option Explicit
Private Sub Form_Load()
Dim i As Integer
Dim mArray(200)
For i = 0 To 100
Randomize
mArray(i) = i
Next i
For i = 101 To 200
Randomize
mArray(i) = Chr(Round(64 * Rnd()) + 65)
Next i
Start_QuickSort mArray, DecendentOrder
For i = 0 To 200
Debug.Print mArray(i)
Next i
End Sub
Dulces Lunas!¡.
Disculpen el Doble post.
PAra el Primero:
http://www.conclase.net/c/orden/burbuja.html
Para quien desee saber mas sobre el Segundo metodo de ORdenamiento:
http://www.conclase.net/c/orden/quicksort.html
Otros:
http://www.conclase.net/c/orden/index.html
Dulces Lunas!¿.
muy bueno!!! es mucho mas complicado entenderlo pero en fin es mucho mas rapido no estoy muy seguro pero creo que hay una forma mas rapida aun utilizando CallWindowProc que masomenos es lo que utilizan los listview pero bueno la verdad ni idea como.
saludos.