Ordenar una matriz multidimensional en VBA

He definido el siguiente Array Dim myArray(10,5) as Long y me gustaría ordenarlo. ¿Cuál sería el mejor método para hacer eso?

Tendré que manejar una gran cantidad de datos, como una matriz de 1000 x 5. Contiene principalmente números y fechas, y necesita ordenarlo según una determinada columna

Aquí hay una QuickSort de columnas múltiples y una columna para VBA, modificada a partir de un ejemplo de código publicado por Jim Rech en Usenet.

Notas:

Notarás que hago mucha más encoding defensiva de la que verás en la mayoría de las muestras de códigos que hay en la web: este es un foro de Excel, y debes anticipar valores nulos y vacíos … O matrices y objetos nesteds en matrices si su matriz de origen proviene (por ejemplo) de una fuente de datos de mercado en tiempo real de terceros.

Los valores vacíos y los elementos no válidos se envían al final de la lista.

Su llamada será:

  QuickSort MyArray ,,, 2 

… Pasando ‘2’ como la columna para ordenar y excluyendo los parámetros opcionales que pasan los límites superior e inferior del dominio de búsqueda.

[EDITADO]: se ha corregido un problema de formato extraño en las tags , que parece tener un problema con los hipervínculos en los comentarios del código.

El hipervínculo que suprimí fue Detectar una variante de matriz en VBA .

 Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0) On Error Resume Next 'Sort a 2-Dimensional array ' SampleUsage: sort arrData by the contents of column 3 ' ' QuickSortArray arrData, , , 3 ' 'Posted by Jim Rech 10/20/98 Excel.Programming 'Modifications, Nigel Heffernan: ' ' Escape failed comparison with empty variant ' ' Defensive coding: check inputs Dim i As Long Dim j As Long Dim varMid As Variant Dim arrRowTemp As Variant Dim lngColTemp As Long If IsEmpty(SortArray) Then Exit Sub End If If InStr(TypeName(SortArray), "()") < 1 Then 'IsArray() is somewhat broken: Look for brackets in the type name Exit Sub End If If lngMin = -1 Then lngMin = LBound(SortArray, 1) End If If lngMax = -1 Then lngMax = UBound(SortArray, 1) End If If lngMin >= lngMax Then ' no sorting required Exit Sub End If i = lngMin j = lngMax varMid = Empty varMid = SortArray((lngMin + lngMax) \ 2, lngColumn) ' We send 'Empty' and invalid data items to the end of the list: If IsObject(varMid) Then ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property i = lngMax j = lngMin ElseIf IsEmpty(varMid) Then i = lngMax j = lngMin ElseIf IsNull(varMid) Then i = lngMax j = lngMin ElseIf varMid = "" Then i = lngMax j = lngMin ElseIf VarType(varMid) = vbError Then i = lngMax j = lngMin ElseIf VarType(varMid) > 17 Then i = lngMax j = lngMin End If While i <= j While SortArray(i, lngColumn) < varMid And i < lngMax i = i + 1 Wend While varMid < SortArray(j, lngColumn) And j > lngMin j = j - 1 Wend If i <= j Then ' Swap the rows ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2)) For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2) arrRowTemp(lngColTemp) = SortArray(i, lngColTemp) SortArray(i, lngColTemp) = SortArray(j, lngColTemp) SortArray(j, lngColTemp) = arrRowTemp(lngColTemp) Next lngColTemp Erase arrRowTemp i = i + 1 j = j - 1 End If Wend If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn) If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn) End Sub 

... Y la versión de matriz de una sola columna:

 Public Sub QuickSortVector(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1) On Error Resume Next 'Sort a 1-Dimensional array ' SampleUsage: sort arrData ' ' QuickSortVector arrData ' ' Originally posted by Jim Rech 10/20/98 Excel.Programming ' Modifications, Nigel Heffernan: ' ' Escape failed comparison with an empty variant in the array ' ' Defensive coding: check inputs Dim i As Long Dim j As Long Dim varMid As Variant Dim varX As Variant If IsEmpty(SortArray) Then Exit Sub End If If InStr(TypeName(SortArray), "()") < 1 Then 'IsArray() is somewhat broken: Look for brackets in the type name Exit Sub End If If lngMin = -1 Then lngMin = LBound(SortArray) End If If lngMax = -1 Then lngMax = UBound(SortArray) End If If lngMin >= lngMax Then ' no sorting required Exit Sub End If i = lngMin j = lngMax varMid = Empty varMid = SortArray((lngMin + lngMax) \ 2) ' We send 'Empty' and invalid data items to the end of the list: If IsObject(varMid) Then ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a default member or property i = lngMax j = lngMin ElseIf IsEmpty(varMid) Then i = lngMax j = lngMin ElseIf IsNull(varMid) Then i = lngMax j = lngMin ElseIf varMid = "" Then i = lngMax j = lngMin ElseIf VarType(varMid) = vbError Then i = lngMax j = lngMin ElseIf VarType(varMid) > 17 Then i = lngMax j = lngMin End If While i <= j While SortArray(i) < varMid And i < lngMax i = i + 1 Wend While varMid < SortArray(j) And j > lngMin j = j - 1 Wend If i <= j Then ' Swap the item varX = SortArray(i) SortArray(i) = SortArray(j) SortArray(j) = varX i = i + 1 j = j - 1 End If Wend If (lngMin < j) Then Call QuickSortVector(SortArray, lngMin, j) If (i < lngMax) Then Call QuickSortVector(SortArray, i, lngMax) End Sub 

Solía ​​usar BubbleSort para este tipo de cosas, pero se ralentiza, severamente, una vez que el conjunto supera las 1024 filas. Incluí el siguiente código para su referencia: tenga en cuenta que no proporcioné el código fuente para ArrayDimensions, por lo que no comstackrá para usted a menos que lo refactorice, o lo dividirá en versiones 'Array' y 'vector'.



 Public Sub BubbleSort (ByRef InputArray, opcional SortColumn As Integer = 0, opcional que desciende como booleano = falso)
 'Ordenar una matriz de 1 o 2 dimensiones.


 Dim iFirstRow como entero
 Dim iLastRow como entero
 Dim iFirstCol como entero
 Dim iLastCol As Integer
 Dim i As Integer
 Dim j como entero
 Dim k como entero
 Dim varTemp como variante
 Dim OutputArray como variante

 Dim iDimensions As Integer



 iDimensions = ArrayDimensions (InputArray)

     Seleccione Case iDimensions
     Caso 1

         iFirstRow = LBound (InputArray)
         iLastRow = UBound (InputArray)

         Para i = iFirstRow a iLastRow - 1
             Para j = i + 1 para iLastRow
                 Si InputArray (i)> InputArray (j) Entonces
                     varTemp = InputArray (j)
                     InputArray (j) = InputArray (i)
                     InputArray (i) = varTemp
                 Terminara si
             Siguiente j
         Siguiente yo

     Caso 2

         iFirstRow = LBound (InputArray, 1)
         iLastRow = UBound (InputArray, 1)

         iFirstCol = LBound (InputArray, 2)
         iLastCol = UBound (InputArray, 2)

         Si SortColumn InputArray (j, SortColumn) Then
                     Para k = iFirstCol a iLastCol
                         varTemp = InputArray (j, k)
                         InputArray (j, k) = InputArray (i, k)
                         InputArray (i, k) = varTemp
                     Siguiente k
                 Terminara si
             Siguiente j
         Siguiente yo

     Fin Seleccionar


     Si desciende entonces

         OutputArray = InputArray

         Para i = LBound (InputArray, 1) Para UBound (InputArray, 1)

             k = 1 + UBound (InputArray, 1) - i
             Para j = LBound (InputArray, 2) Para UBound (InputArray, 2)
                 InputArray (i, j) = OutputArray (k, j)
             Siguiente j
         Siguiente yo

         Borrar OutputArray

     Terminara si


 End Sub


Esta respuesta puede haber llegado un poco tarde para resolver su problema cuando lo necesitó, pero otras personas lo buscarán cuando busquen respuestas para problemas similares.

La parte difícil es que VBA no proporciona una manera directa de intercambiar filas en una matriz 2D. Para cada intercambio, tendrá que recorrer más de 5 elementos e intercambiar cada uno, lo que será muy ineficiente.

Sin embargo, supongo que una matriz 2D realmente no es lo que deberías estar usando. ¿Tiene cada columna un significado específico? De ser así, ¿no debería usar una matriz de un tipo definido por el usuario o una matriz de objetos que son instancias de un módulo de clase? Incluso si las 5 columnas no tienen significados específicos, aún podría hacer esto, pero defina el UDT o módulo de clase para tener solo un miembro que sea una matriz de 5 elementos.

Para el algoritmo de ordenamiento en sí, usaría un simple y viejo ‘Insertion Sort’. 1000 elementos en realidad no es tan grande, y probablemente no notará la diferencia entre una ordenación por inserción y una clasificación rápida, siempre que nos aseguremos de que cada intercambio no sea demasiado lento. Si usa una clasificación rápida, necesitará codificarla cuidadosamente para asegurarse de que no se quede sin espacio en la stack, lo cual se puede hacer, pero es complicado, y la clasificación rápida ya es lo suficientemente complicada.

Entonces, suponiendo que utilice una matriz de UDT, y suponiendo que el UDT contiene variantes denominadas Campo1 a Campo5, y suponiendo que deseamos ordenar en Campo2 (por ejemplo), entonces el código podría verse más o menos así …

 Type MyType Field1 As Variant Field2 As Variant Field3 As Variant Field4 As Variant Field5 As Variant End Type Sub SortMyDataByField2(ByRef Data() As MyType) Dim FirstIdx as Long, LastIdx as Long FirstIdx = LBound(Data) LastIdx = UBound(Data) Dim I as Long, J as Long, Temp As MyType For I=FirstIdx to LastIdx-1 For J=I+1 to LastIdx If Data(I).Field2 > Data(J).Field2 Then Temp = Data(I) Data(I) = Data(J) Data(J) = Temp End If Next J Next I End Sub 

a veces la respuesta más descerebrada es la mejor respuesta.

  1. agregar hoja en blanco
  2. descarga tu matriz a esa hoja
  3. agregar los campos de clasificación
  4. aplicar el género
  5. volver a cargar los datos de la hoja a su matriz será la misma dimensión
  6. eliminar la hoja

tadaa. no ganará ningún premio de progtwigción, pero hace el trabajo rápido.

Voy a ofrecer un poco de código diferente al enfoque de Steve.

Todos los puntos válidos sobre la eficiencia, pero para ser sincero … cuando estaba buscando una solución, me podría haber importado menos la eficiencia. Su VBA … Lo trato como se merece.

Desea ordenar una matriz de 2 d. Tipo de inserción simple sucia simple simple que aceptará una matriz de tamaño variable y ordenará en una columna seleccionada.

 Sub sort_2d_array(ByRef arrayin As Variant, colid As Integer) 'theWidth = LBound(arrayin, 2) - UBound(arrayin, 2) For i = LBound(arrayin, 1) To UBound(arrayin, 1) searchVar = arrayin(i, colid) For ii = LBound(arrayin, 1) To UBound(arrayin, 1) compareVar = arrayin(ii, colid) If (CInt(searchVar) > CInt(compareVar)) Then For jj = LBound(arrayin, 2) To UBound(arrayin, 2) larger1 = arrayin(i, jj) smaller1 = arrayin(ii, jj) arrayin(i, jj) = smaller1 arrayin(ii, jj) = larger1 Next jj i = LBound(arrayin, 1) searchVar = arrayin(i, colid) End If Next ii Next i End Sub 

Por lo que vale (no puedo mostrar el código en este punto … déjame ver si puedo editarlo para publicarlo), creé una matriz de objetos personalizados (por lo que cada una de las propiedades viene con cualquier elemento ordenado por) , llenó un conjunto de celdas con cada objeto de elementos propiedades de interés y luego utilizó la función de clasificación de Excel a través de vba para ordenar la columna. Estoy seguro de que probablemente haya una manera más eficiente de clasificarlo, en lugar de exportarlo a las células, pero aún no me he dado cuenta. En realidad, esto me ayudó mucho porque cuando necesité agregar una dimensión, simplemente agregué una propiedad let and get para la siguiente dimensión de la matriz.

Podría hacer una matriz separada con 2 columnas. La columna 1 sería lo que su clasificación y 2 es qué fila está en otra matriz. Clasifique esta matriz por la columna 1 (solo cambia las dos columnas cuando se intercambia). Entonces podría usar las 2 matrices para procesar datos según sea necesario. Enormes arreglos podrían darte problemas de memoria

Me parece que el código QuickSort anterior no puede manejar espacios. Tengo una matriz con números y espacios. Cuando ordeno esta matriz, los registros con espacios se mezclan entre los registros con números. Me llevó mucho tiempo averiguarlo, así que probablemente sea bueno tenerlo en cuenta cuando uses este código.

mejor, Marcel