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 freeFai sapere…