¿Función de clasificación de matriz VBA?
Estoy buscando una implementación de clasificación decente para matrices en VBA. Se preferiría un Quicksort. O cualquier otro algoritmo de clasificación que no sea el de burbuja o fusión sería suficiente.
Tenga en cuenta que esto funciona con MS Project 2003, por lo que debe evitar cualquiera de las funciones nativas de Excel y cualquier cosa relacionada con .net.
Échale un vistazo aquí :
Editar: la fuente a la que se hace referencia (allexperts.com) ya se cerró, pero aquí están los comentarios relevantes del autor :
Hay muchos algoritmos disponibles en la web para ordenar. El más versátil y normalmente el más rápido es el algoritmo Quicksort . A continuación se muestra una función para ello.
Llámelo simplemente pasando una matriz de valores (cadena o numéricos; no importa) con el límite inferior de la matriz (generalmente
0) y el límite superior de la matriz (es decir,UBound(myArray)).Ejemplo :
Call QuickSort(myArray, 0, UBound(myArray))Cuando termine,
myArrayse ordenará y podrás hacer lo que quieras con él.
(Fuente: archive.org )
Public Sub QuickSort(vArray As Variant, inLow As Long, inHi As Long)
Dim pivot As Variant
Dim tmpSwap As Variant
Dim tmpLow As Long
Dim tmpHi As Long
tmpLow = inLow
tmpHi = inHi
pivot = vArray((inLow + inHi) \ 2)
While (tmpLow <= tmpHi)
While (vArray(tmpLow) < pivot And tmpLow < inHi)
tmpLow = tmpLow + 1
Wend
While (pivot < vArray(tmpHi) And tmpHi > inLow)
tmpHi = tmpHi - 1
Wend
If (tmpLow <= tmpHi) Then
tmpSwap = vArray(tmpLow)
vArray(tmpLow) = vArray(tmpHi)
vArray(tmpHi) = tmpSwap
tmpLow = tmpLow + 1
tmpHi = tmpHi - 1
End If
Wend
If (inLow < tmpHi) Then QuickSort vArray, inLow, tmpHi
If (tmpLow < inHi) Then QuickSort vArray, tmpLow, inHi
End Sub
Tenga en cuenta que esto sólo funciona con matrices unidimensionales (¿también conocidas como "normales"?). ( Aquí hay un QuickSort de matriz multidimensional que funciona ).
Convertí el algoritmo de 'clasificación rápida y rápida' a VBA, por si alguien más lo quiere.
Lo tengo optimizado para ejecutarse en una matriz de Int/Longs, pero debería ser sencillo convertirlo a uno que funcione en elementos arbitrarios comparables.
Private Sub QuickSort(ByRef a() As Long, ByVal l As Long, ByVal r As Long)
Dim M As Long, i As Long, j As Long, v As Long
M = 4
If ((r - l) > M) Then
i = (r + l) / 2
If (a(l) > a(i)) Then swap a, l, i '// Tri-Median Methode!'
If (a(l) > a(r)) Then swap a, l, r
If (a(i) > a(r)) Then swap a, i, r
j = r - 1
swap a, i, j
i = l
v = a(j)
Do
Do: i = i + 1: Loop While (a(i) < v)
Do: j = j - 1: Loop While (a(j) > v)
If (j < i) Then Exit Do
swap a, i, j
Loop
swap a, i, r - 1
QuickSort a, l, j
QuickSort a, i + 1, r
End If
End Sub
Private Sub swap(ByRef a() As Long, ByVal i As Long, ByVal j As Long)
Dim T As Long
T = a(i)
a(i) = a(j)
a(j) = T
End Sub
Private Sub InsertionSort(ByRef a(), ByVal lo0 As Long, ByVal hi0 As Long)
Dim i As Long, j As Long, v As Long
For i = lo0 + 1 To hi0
v = a(i)
j = i
Do While j > lo0
If Not a(j - 1) > v Then Exit Do
a(j) = a(j - 1)
j = j - 1
Loop
a(j) = v
Next i
End Sub
Public Sub sort(ByRef a() As Long)
QuickSort a, LBound(a), UBound(a)
InsertionSort a, LBound(a), UBound(a)
End Sub
Dim arr As Object
Dim InputArray
'Creating a array list
Set arr = CreateObject("System.Collections.ArrayList")
'String
InputArray = Array("d", "c", "b", "a", "f", "e", "g")
'number
'InputArray = Array(6, 5, 3, 4, 2, 1)
' adding the elements in the array to array_list
For Each element In InputArray
arr.Add element
Next
'sorting happens
arr.Sort
'Converting ArrayList to an array
'so now a sorted array of elements is stored in the array sorted_array.
sorted_array = arr.toarray
