Vba Excel Ordinare Matrice

[Francesco53]

Un saluto a tutto il Forum, espongo la mia difficoltà:
Ho una matrice e devo ordinarla senza usare funzioni di excel ma solo codice vba.
Allego file dove a sinistra ci sono i dati della matrice, a destra come dovrebbe essere l'ordinamento finale.
Ho provato diversi cicli ma non riesco ad ottenere il giusto ordinamento.
https://www.mediafire.com/file/xgzvfx1g5114v5h/PcFacile.xlsb/file
Grazie a chi può aiutarmi,
Francesco

[alfrimpa]

Non puoi ordinare la matrice registrando una macro?

Al termine avrai il codice.

[Francesco53]

Ciao Alfredo, se uso le funzioni di excel riesco a farlo anche senza registrare la macro,
come ho scritto non devo usare funzioni excel in quanto il codice deve essere utilizzato
in altra tipologia di foglio.
Francesco

[Anthony47]

Hummm... Secondo me dovresti essere piu' esplicito...
Insomma vuoi capire come si fa a ordinare in vba una matrice, senza che questa corrisponda necessariamente a una tabella Excel?

Se fosse questa la richiesta, allora potrebbe aiutarti questa Funzione:

Codice: Seleziona tutto

Function bbSort(ByVal lArr, Optional iSort1 As Long = 0, Optional SDir1 As Boolean = False, _
            Optional iSort2 As Long = 0, Optional SDir2 As Boolean = False) As Variant
'byAnthony, vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110874
'scopo:     Ordinamento Crescente /Decrescente di un Array bidimensionale
'richiamo:  bbSort(ArrayToSort, [Column1ToSort, [SortDirection1]], [Column2ToSort, [SortDirection2]])
'           Se Column1ToSort e' omesso oppure 0, allora Nessun Ordinamento; 1 = Ordina per colonna #1, 2 = per colonna #2, etc
'           Se SortDirection e' omesso oppure =Falso, allora Ordine=Crescente; True = Decrescente
'           Column2ToSort e' Opzionale
'
Dim tTmp, LiSort, I As Long, J As Long, K As Long, UB2 As Long, lB0 As Long
Dim F1Mag As Boolean, F1Min As Boolean, F2Mag As Boolean, F2Min As Boolean, LiSort2
Dim ASw As Boolean
'
On Error Resume Next
UB2 = UBound(lArr, 2)
On Error GoTo 0
If iSort1 > 0 And UB2 > 1 Then
    lB0 = LBound(lArr)
    LiSort = iSort1 - 1
    For I = lB0 To UBound(lArr) - 1
        For J = I + 1 To UBound(lArr)
            'Compila i Flag di situazione
            If (lArr(I, lB0 + LiSort)) > (lArr(J, lB0 + LiSort)) Then
                F1Mag = True: F1Min = False
            ElseIf (lArr(I, lB0 + LiSort)) < (lArr(J, lB0 + LiSort)) Then
                F1Min = True: F1Mag = False
            Else
                F1Min = False: F1Mag = False
            End If
            If iSort2 > 0 Then
                LiSort2 = iSort2 - 1
                If (lArr(I, lB0 + LiSort2)) > (lArr(J, lB0 + LiSort2)) Then
                    F2Mag = True: F2Min = False
                ElseIf (lArr(I, lB0 + LiSort2)) < (lArr(J, lB0 + LiSort2)) Then
                    F2Min = True: F2Mag = False
                Else
                    F2Min = False: F2Mag = False
                End If
            End If
            'Calcola se necessario Switch di posizione:
            If (SDir1 = False And F1Mag) Or (SDir1 = True And F1Min) Then
                ASw = True
            ElseIf F1Mag = F1Min And (SDir2 = False And F2Mag) Then
                ASw = True
            ElseIf F1Mag = F1Min And (SDir2 = True And F2Min) Then
                ASw = True
            Else
                ASw = False
            End If
            'Esegui eventuale switch di posizione:
            If ASw Then
                For K = LBound(lArr, 2) To UBound(lArr, 2)
                    tTmp = lArr(J, K)
                    lArr(J, K) = lArr(I, K)
                    lArr(I, K) = tTmp
                Next K
            End If
DoEvents
        Next J
    Next I
End If
bbSort = lArr
End Function


Opera con l'approccio "bubble sort" (quindi per matrici lunghette potrebbe mostrare segni di rallentamento; con 100 righe nel mio test impiega 0.5 sec, ma dipende dagli ordinamenti da fare)

Da vba, una volta che hai una matrice popolata, devi richiamare la Function bbSort passandogli come argomento:
-il nome della matrice
-su quale colonna va fatto il primo Ordinamento (1=prima, 2=seconda, etc)
-False o omesso per Ordinamento Crescente; True per ordinamento Decrescente
-opzionale: parametro seconda colonna e secondo tipo di ordinamento

La Function restituisce una matrice con le stesse dimensione della matrice da ordinare

Ad esempio, con i tuoi dati, io ho popolato la matrice WArr e ho scritto i risultati in J2 e dintorni:
Dati di partenza


Macro di prova:

Codice: Seleziona tutto

Sub DemoSort()
Dim WArr, TOrig As String
'
mytim = Timer
TOrig = "B2"
WArr = Range(Range(TOrig), Range(TOrig).Offset(0, 1).End(xlDown)).Value
Range("K2").Resize(UBound(WArr), UBound(WArr, 2)).Value = bbSort(WArr, 1, False, 2, False)
Debug.Print Timer - mytim
End Sub


Risultato:
host image free

Fai sapere…

[Francesco53]

Ciao Anthony, ho provato la Funzione ed è perfetta come sempre.
Grazie
Francesco