简体   繁体   中英

How to sort 2d array with multiple columns vba?

I want to sort a 2-D array with 3 different columns. The 1st column, 3rd column and then 6th column. I am using the subprocedure provided here Sorting a multidimensionnal array in VBA

I have tried nested calling but getting an error

Call QuickSortArray(QuickSortArray(QuickSortArray(StatFcstData, , , 1), , , 3), , , 6)

and also tried one column after another but I am not getting correct sort order in the result.

QuickSortArray(StatFcstData, , , 1)
QuickSortArray(StatFcstData, , , 3)
QuickSortArray(StatFcstData, , , 6)

It should ideally sort the whole data set within the array sorted first by column 1 and then column 3 and then column 6. But, what it currently does is it applies the sort column 6 and overrides sorting of column 1 and 3 as per the code what I already tried

It'll never work if you just use QuickSortArray multiple times, because it will not keep the last sort you did. It will just apply the new sort over the last one.

Well, it's a little too late now, but I did it :) So I'll just post my resolution here if someone wants it.

I created a Sub that interacts with QuickSortArray, allowing you to apply how many sorts you want and keeping the all the other sorts you did.

Calling the sub

vTable is the 2D array. Then just write all the columns to sort in the right order inside the array.

ComplexSorting vTable, Array(7, 8, 2, 1)

It's not as big as it looks. It's just well commented. It's not that crazy and works pretty fast.

I hope it helps ;)

Sub ComplexSorting(ByRef SortArray As Variant, sColumns As Variant)

'Posted by Lucas Almeida 06/04/21:

'This ComplexSorting was created thanks to the help of QuickSortArray for 2D dimensinal Arrays created by:

'Posted by Jim Rech 10/20/98 Excel.Programming
'Modifications, Nigel Heffernan:


'DESCRIPTION:
'ComplexSorting works similar to the Advanced Sort for Excel Tables
'So it can apply multiple sorts to the same 2D Array at the same time


'ARGUMENT VARIABLES:
'SortArray - is the 2D array you want to sort
'sColumns - are the columns you want to sort as numbers - Example: sColumns = Array(7, 2, 3)

'Keep in mind that in this example (7, 2, 3) it will sort the column 7 FIRST, then the 2nd column, then the 3rd
'So it sorts from left to right


'SampleUsage: ComplexSorting vTable, Array(7, 8, 2, 1)


'I haven't made a lot of error handlers, but if you pass the arguments in the right way, everything should work just fine ;)


Dim i As Integer, i1 As Long, Min As Long, Max As Long, MinSort As Long, MaxSort As Long

Dim Str(1 To 1) As Variant

For i = LBound(sColumns) To UBound(sColumns)
    If Not IsNumeric(sColumns(i)) Or IsEmpty(sColumns(i)) Then
        Err.Raise vbObjectError + 513, , "Only integers must be in sColumns array"
    End If
Next

'Do the first Sort
QuickSortArray SortArray, , , CLng(sColumns(LBound(sColumns)))

'If there is just one number inside sColumns, just exit sub
If LBound(sColumns) = UBound(sColumns) Then
    Exit Sub
End If

MinSort = LBound(SortArray)
MaxSort = UBound(SortArray)

'For each column you want to Sort (after the first)
For i = LBound(sColumns) + 1 To UBound(sColumns)
    
    Min = MinSort
    
    'For each line inside the 2D array
    For i1 = MinSort To MaxSort
        
        'It will search for the first(Min) and last(Max) line of occurrence for each value inside the last already sorted column
        'It will run the QuickSortArray based on the Min and Max
        
        If Min = i1 Then 'If it is the first occurrence of the value
            If SortArray(i1, sColumns(i - 1)) = SortArray(i1 + 1, sColumns(i - 1)) Then 'if the next value is equal to this first value
                Str(1) = SortArray(i1, sColumns(i - 1))
            Else
            
                Min = Min + 1 'No need for sorting - unique value in the column
            End If
            
        Else
            If MaxSort = i1 Then 'Last Line - Needed to evade the error in the ElseIf because of SortArray(i1 + 1)
                
                Max = i1
                
                QuickSortArray SortArray, Min, Max, CLng(sColumns(i)) 'Sort
                
            ElseIf SortArray(i1, sColumns(i - 1)) <> SortArray(i1 + 1, sColumns(i - 1)) Then 'If the next value is a new value
                
                Max = i1
                
                QuickSortArray SortArray, Min, Max, CLng(sColumns(i)) 'Sort
                
                Min = i1 + 1
            End If
        End If
    Next
Next

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM