0

我想对具有 3 个不同列的二维数组进行排序。第 1 列、第 3 列和第 6 列。我正在使用此处提供的子过程在 VBA 中对多维数组进行排序

我尝试过嵌套调用但出现错误

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

并且还尝试了一列又一列，但我没有在结果中得到正确的排序顺序。

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

理想情况下，它应该对数组中的整个数据集进行排序，首先按第 1 列、第 3 列和第 6 列排序。但是，它当前所做的是应用第 6 列的排序并根据代码覆盖第 1 列和第 3 列的排序我已经尝试过的

4

1 回答 1

0

如果您只是多次使用 QuickSortArray，它永远不会起作用，因为它不会保留您所做的最后一次排序。它只会在最后一个上应用新的排序。

好吧，现在有点太晚了，但我做到了:) 所以如果有人想要，我会在这里发布我的决议。

我创建了一个与 QuickSortArray 交互的 Sub，允许您应用所需的排序数量并保留您所做的所有其他排序。

调用子

vTable 是二维数组。然后只需将所有列写入数组内以正确顺序排序。

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

它不像看起来那么大。它只是很好的评论。这不是那么疯狂，而且工作得很快。

我希望它有帮助；）

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
于 2021-06-05T03:31:57.813 回答