Ordinamento di un array multidimensionale in VBA

Question

Ho definito la seguente matrice Dim myArray(10,5) as Long e vorrei ordinarla. Quale sarebbe il miglior metodo per farlo?

Avrò bisogno di gestire molti dati come una matrice 1000 x 5. Esso contiene principalmente numeri e date e deve essere ordinato in base a una determinata colonna

Answer 1

Ecco una colonna multipla e una colonna singola QuickSort per VBA, modificata da un esempio di codice pubblicato da Jim Rech su Usenet.

Note:

Si noterà che faccio un sacco codifica più difensivo di quello che vedrete nella maggior parte dei campioni di codice là fuori sul web: questo è un forum di Excel, e si' bisogna anticipare valori nulli e valori vuoti ... O matrici e oggetti annidati negli array se l'array sorgente proviene (diciamo) da un'origine dati di mercato in tempo reale di terze parti.

I valori vuoti e gli articoli non validi vengono inviati alla fine dell'elenco.

La vostra chiamata sarà:

 QuickSort MyArray,,,2

... Passando "2" come colonna per ordinare e escludendo i parametri facoltativi che superano i limiti superiore e inferiore del dominio di ricerca.

[MODIFICATO] - risolto un problema di formattazione dispari nei tag > codice >, che sembrano avere un problema con collegamenti ipertestuali nei commenti di codice.

Il collegamento ipertestuale che ho escisso era 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 

... E la colonna singola versione array:

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 

ho utilizzato BubbleSort per questo genere di cose, ma rallenta, gravemente, dopo la matrice supera 1024 righe.Includo il seguente codice per il tuo riferimento: tieni presente che non ho fornito il codice sorgente per ArrayDimensions, quindi questo non verrà compilato per te a meno che non lo rifatti, o diviso in versioni "Array" e "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 

Questa risposta potrebbe essere arrivato un po 'tardi per risolvere il problema quando avevi bisogno di, ma altre persone lo pick up quando Google per le risposte per problemi simili.

Answer 2

La parte difficile è che VBA non fornisce un modo semplice per scambiare le righe in un array 2D. Per ogni scambio, dovrai eseguire il ciclo di oltre 5 elementi e scambiare ciascuno di essi, il che sarà molto inefficiente.

Immagino che un array 2D non sia in realtà quello che dovresti usare comunque. Ogni colonna ha un significato specifico? In tal caso, non dovresti utilizzare un array di un tipo definito dall'utente o un array di oggetti che sono istanze di un modulo di classe? Anche se le 5 colonne non hanno significati specifici, puoi ancora farlo, ma definisci l'UDT o il modulo di classe in modo che abbia un solo membro che è un array di 5 elementi.

Per l'algoritmo di ordinamento stesso, vorrei utilizzare un semplice ordine di inserimento. 1000 articoli in realtà non sono così grandi, e probabilmente non noterai la differenza tra un Sort Sort e Quick Sort, a patto che ci siamo assicurati che ogni swap non sia troppo lento. Se si utilizza per l'ordinamento rapido, è necessario codificarlo attentamente per assicurarsi che non si esaurisca lo spazio di stack, operazione che può essere eseguita, ma è complicato e Quick Sort è già abbastanza complicato.

Quindi supponendo che si utilizza una matrice di UDT, e assumendo l'UDT contiene varianti denominati Field1 attraverso Campo5, e supponendo che vogliamo ordinare il Campo2 (per esempio), allora il codice potrebbe essere simile a questo ...

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 volte la risposta più senza cervello è la migliore risposta.

1. aggiungere foglio bianco
2. scaricare l'array a quel foglio
3. aggiungere i campi di ordinamento
4. applicare l'ordinamento
5. ricaricare i dati del foglio di nuovo al vostro array sarà la stessa dimensione
6. elimina il foglio

tadaa. non ti conquisterà alcun premio di programmazione ma farà il lavoro velocemente.

Answer 4

Ho intenzione di offrire un po 'di codice diverso all'approccio di Steve.

Tutti i punti validi sull'efficienza, ma ad essere sinceri .. quando stavo cercando una soluzione, avrei potuto preoccuparmi meno dell'efficienza. Il suo VBA ... lo tratto come merita.

Si desidera ordinare un array 2-d. Ordinamento semplice semplice e sporco semplice che accetta una matrice di dimensioni variabili e ordina su una colonna selezionata.

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

Mi sembra che il codice QuickSort sopra non possa gestire gli spazi. Ho una matrice con numeri e spazi. Quando ordino questa matrice, i record con gli spazi sono confusi tra i record con i numeri. Mi ci è voluto un sacco di tempo per scoprirlo, quindi probabilmente è bene tenerlo a mente quando usi questo codice.

migliore, Marcel

Answer 6

Per quel che vale (non riesco a mostrare il codice a questo punto ... fammi vedere se riesco a modificarlo per post), ho creato un array di oggetti personalizzati (così ognuna delle proprietà viene fornita con qualsiasi elemento è ordinata per), popolato un insieme di celle con ogni proprietà dell'oggetto di interesse degli oggetti quindi ha utilizzato la funzione di ordinamento excel tramite vba per ordinare la colonna. Sono sicuro che c'è probabilmente un modo più efficiente di ordinarlo, piuttosto che esportarlo in celle, non l'ho ancora capito. Questo in realtà mi ha aiutato molto perché quando ho avuto bisogno di aggiungere una dimensione, ho appena aggiunto un let e ottenere la proprietà per la prossima dimensione della matrice.