Ordenar una matriz multidimensional en VBA

Question

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

Necesitaré 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

Answer 1

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:

Se dará cuenta de que hago un montón codificación más defensiva que se verá en la mayoría de los ejemplos de código que hay en la red: Este es un foro Excel y' Tengo que anticipar nulos y valores vacíos ... O matrices anidadas y objetos en matrices si su matriz de origen proviene (digamos) 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 error de formato impar en < código > etiquetas, que parecen tener un problema con los hipervínculos en los comentarios del código.

El hipervínculo que eliminé fue Detecting an Array Variant in 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 única columna de matriz versión:

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, gravemente, después de la matriz supera 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 compilará para usted a menos que lo refactorice, o lo dividirá en versiones 'Array' y 'vector'.

 


Public Sub BubbleSort(ByRef InputArray, Optional SortColumn As Integer = 0, Optional Descending As Boolean = False) 
' Sort a 1- or 2-Dimensional array. 


Dim iFirstRow As Integer 
Dim iLastRow As Integer 
Dim iFirstCol As Integer 
Dim iLastCol As Integer 
Dim i   As Integer 
Dim j   As Integer 
Dim k   As Integer 
Dim varTemp  As Variant 
Dim OutputArray As Variant 

Dim iDimensions As Integer 



iDimensions = ArrayDimensions(InputArray) 

    Select Case iDimensions 
    Case 1 

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

     For i = iFirstRow To iLastRow - 1 
      For j = i + 1 To iLastRow 
       If InputArray(i) > InputArray(j) Then 
        varTemp = InputArray(j) 
        InputArray(j) = InputArray(i) 
        InputArray(i) = varTemp 
       End If 
      Next j 
     Next i 

    Case 2 

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

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

     If SortColumn InputArray(j, SortColumn) Then 
        For k = iFirstCol To iLastCol 
         varTemp = InputArray(j, k) 
         InputArray(j, k) = InputArray(i, k) 
         InputArray(i, k) = varTemp 
        Next k 
       End If 
      Next j 
     Next i 

    End Select 


    If Descending Then 

     OutputArray = InputArray 

     For i = LBound(InputArray, 1) To UBound(InputArray, 1) 

      k = 1 + UBound(InputArray, 1) - i 
      For j = LBound(InputArray, 2) To UBound(InputArray, 2) 
       InputArray(i, j) = OutputArray(k, j) 
      Next j 
     Next i 

     Erase OutputArray 

    End If 


End Sub 

Esta respuesta puede haber llegado un poco tarde para resolver su problema cuando se necesitaba, pero otras personas lo recogerá cuando Google en busca de respuestas para problemas similares.

Answer 2

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.

Supongo que una matriz 2D no es realmente lo que debería estar usando de todos modos. ¿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 ol '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 use una clasificación rápida, necesitará codificarla cuidadosamente para asegurarse de que no se quede sin espacio en la pila, lo que se puede hacer, pero es complicado, y Quick Sort ya es lo suficientemente complicado.

Así que asumiendo que utiliza una matriz de UDT, y asumiendo la UDT contiene variantes denomina campo1 través Field5, y suponiendo que desea ordenar en Campo2 (por ejemplo), entonces el código podría ser algo como esto ...

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 

Answer 3

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

1. añadir hoja en blanco
2. descargar la matriz a esa hoja
3. añadir los campos de clasificación
4. aplicar el tipo
5. Reupload los datos de la hoja de nuevo a la matriz será la misma dimensión
6. borre la hoja

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

Answer 4

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 

Answer 5

Me parece que el código anterior de QuickSort no puede ocupar 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

Answer 6

Por lo que vale la pena (no puedo mostrar código en este momento ... déjame ver si puedo editarlo para publicar), he creado una matriz de objetos personalizados (por lo 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.