我想对具有 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 列覆盖排序编写我已经尝试过的代码
如果您多次使用 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
添加到上面的 marc_s 帖子。我不断收到错误，因为它会到达数组末尾，然后递增并尝试读取数组之外的值。似乎有人试图避免这个问题“'最后一行 - 由于 SortArray(i1 + 1)，需要避免 ElseIf 中的错误”，但它并不总是有效。
我的廉价修复方法如下所示。似乎对我有用。
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 MaxSort = il Then
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
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