在 VBA 中对多维数组进行排序
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/4873182/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Sorting a multidimensionnal array in VBA
提问by BlackLabrador
I have defined the following Array Dim myArray(10,5) as Longand would like to sort it. What would be the best method to do that?
我已经定义了以下数组Dim myArray(10,5) as Long并希望对其进行排序。什么是最好的方法来做到这一点？
I will need to handle a lot of data like a 1000 x 5 Matrix. It contains mainly numbers and dates and need to sort it according to a certain column
我需要处理大量数据，例如 1000 x 5 矩阵。主要包含数字和日期，需要按照某一列进行排序
回答by Nigel Heffernan
Here's a multi-column and a single-column QuickSort for VBA, modified from a code sample posted by Jim Rech on Usenet.
这是 VBA 的多列和单列 QuickSort，修改自 Jim Rech 在 Usenet 上发布的代码示例。
Notes:
笔记：
You'll notice that I do a lotmore defensive coding than you'll see in most of the code samples out there on the web: this is an Excel forum, and you've got to anticipate nulls and empty values... Or nested arrays and objects in arrays if your source array comes from (say) a third-party realtime market data source.
你会发现，我做了很多更具防御性的编码比你在大部分的代码示例看到那里的网站：这是一个Excel论坛，你必须事先估计到空和空值...或者如果您的源数组来自（例如）第三方实时市场数据源，则嵌套数组和数组中的对象。
Empty values and invalid items are sent to the end of the list.
空值和无效项目被发送到列表的末尾。
Your call will be:
您的电话将是：
QuickSort MyArray,,,2...将“2”作为列进行排序并排除通过搜索域的上限和下限的可选参数。
[EDITED] - fixed an odd formatting glitch in the <code> tags, which seem to have a problem with hyperlinks in code comments.
[已编辑] - 修复了 <code> 标签中一个奇怪的格式故障，这似乎在代码注释中存在超链接问题。
The Hyperlink I excised was Detecting an Array Variant in VBA.
我切除的超链接是Detecting an Array Variant in VBA。
Public Sub QuickSortArray(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1, Optional lngColumn As Long = 0)
On Error Resume Next
'Sort a 2-Dimensional array
' SampleUsage: sort arrData by the contents of column 3
'
' QuickSortArray arrData, , , 3
'
'Posted by Jim Rech 10/20/98 Excel.Programming
'Modifications, Nigel Heffernan:
' ' Escape failed comparison with empty variant
' ' Defensive coding: check inputs
Dim i As Long
Dim j As Long
Dim varMid As Variant
Dim arrRowTemp As Variant
Dim lngColTemp As Long
If IsEmpty(SortArray) Then
Exit Sub
End If
If InStr(TypeName(SortArray), "()") < 1 Then 'IsArray() is somewhat broken: Look for brackets in the type name
Exit Sub
End If
If lngMin = -1 Then
lngMin = LBound(SortArray, 1)
End If
If lngMax = -1 Then
lngMax = UBound(SortArray, 1)
End If
If lngMin >= lngMax Then ' no sorting required
Exit Sub
End If
i = lngMin
j = lngMax
varMid = Empty
varMid = SortArray((lngMin + lngMax) \ 2, lngColumn)
' We send 'Empty' and invalid data items to the end of the list:
If IsObject(varMid) Then ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a valid default member or property
i = lngMax
j = lngMin
ElseIf IsEmpty(varMid) Then
i = lngMax
j = lngMin
ElseIf IsNull(varMid) Then
i = lngMax
j = lngMin
ElseIf varMid = "" Then
i = lngMax
j = lngMin
ElseIf VarType(varMid) = vbError Then
i = lngMax
j = lngMin
ElseIf VarType(varMid) > 17 Then
i = lngMax
j = lngMin
End If
While i <= j
While SortArray(i, lngColumn) < varMid And i < lngMax
i = i + 1
Wend
While varMid < SortArray(j, lngColumn) And j > lngMin
j = j - 1
Wend
If i <= j Then
' Swap the rows
ReDim arrRowTemp(LBound(SortArray, 2) To UBound(SortArray, 2))
For lngColTemp = LBound(SortArray, 2) To UBound(SortArray, 2)
arrRowTemp(lngColTemp) = SortArray(i, lngColTemp)
SortArray(i, lngColTemp) = SortArray(j, lngColTemp)
SortArray(j, lngColTemp) = arrRowTemp(lngColTemp)
Next lngColTemp
Erase arrRowTemp
i = i + 1
j = j - 1
End If
Wend
If (lngMin < j) Then Call QuickSortArray(SortArray, lngMin, j, lngColumn)
If (i < lngMax) Then Call QuickSortArray(SortArray, i, lngMax, lngColumn)
End Sub
... And the single-column array version:
...和单列数组版本：
Public Sub QuickSortVector(ByRef SortArray As Variant, Optional lngMin As Long = -1, Optional lngMax As Long = -1)
On Error Resume Next
'Sort a 1-Dimensional array
' SampleUsage: sort arrData
'
' QuickSortVector arrData
'
' Originally posted by Jim Rech 10/20/98 Excel.Programming
' Modifications, Nigel Heffernan:
' ' Escape failed comparison with an empty variant in the array
' ' Defensive coding: check inputs
Dim i As Long
Dim j As Long
Dim varMid As Variant
Dim varX As Variant
If IsEmpty(SortArray) Then
Exit Sub
End If
If InStr(TypeName(SortArray), "()") < 1 Then 'IsArray() is somewhat broken: Look for brackets in the type name
Exit Sub
End If
If lngMin = -1 Then
lngMin = LBound(SortArray)
End If
If lngMax = -1 Then
lngMax = UBound(SortArray)
End If
If lngMin >= lngMax Then ' no sorting required
Exit Sub
End If
i = lngMin
j = lngMax
varMid = Empty
varMid = SortArray((lngMin + lngMax) \ 2)
' We send 'Empty' and invalid data items to the end of the list:
If IsObject(varMid) Then ' note that we don't check isObject(SortArray(n)) - varMid *might* pick up a default member or property
i = lngMax
j = lngMin
ElseIf IsEmpty(varMid) Then
i = lngMax
j = lngMin
ElseIf IsNull(varMid) Then
i = lngMax
j = lngMin
ElseIf varMid = "" Then
i = lngMax
j = lngMin
ElseIf VarType(varMid) = vbError Then
i = lngMax
j = lngMin
ElseIf VarType(varMid) > 17 Then
i = lngMax
j = lngMin
End If
While i <= j
While SortArray(i) < varMid And i < lngMax
i = i + 1
Wend
While varMid < SortArray(j) And j > lngMin
j = j - 1
Wend
If i <= j Then
' Swap the item
varX = SortArray(i)
SortArray(i) = SortArray(j)
SortArray(j) = varX
i = i + 1
j = j - 1
End If
Wend
If (lngMin < j) Then Call QuickSortVector(SortArray, lngMin, j)
If (i < lngMax) Then Call QuickSortVector(SortArray, i, lngMax)
End Sub
I used to use BubbleSort for this kind of thing, but it slows down, severely, after the array exceeds 1024 rows. I include the code below for your reference: please note that I haven't provided source code for ArrayDimensions, so this will not compile for you unless you refactor it - or split it out into 'Array' and 'vector' versions.
我曾经将 BubbleSort 用于这种事情，但在数组超过 1024 行后，它会严重变慢。我提供了以下代码供您参考：请注意，我没有提供 ArrayDimensions 的源代码，因此除非您对其进行重构或将其拆分为“Array”和“vector”版本，否则它不会为您编译。
Public Sub BubbleSort(ByRef InputArray, Optional SortColumn As Integer = 0, Optional Descending As Boolean = False)
' Sort a 1- or 2-Dimensional array.
Dim iFirstRow As Integer
Dim iLastRow As Integer
Dim iFirstCol As Integer
Dim iLastCol As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim varTemp As Variant
Dim OutputArray As Variant
Dim iDimensions As Integer
iDimensions = ArrayDimensions(InputArray)
Select Case iDimensions
Case 1
iFirstRow = LBound(InputArray)
iLastRow = UBound(InputArray)
For i = iFirstRow To iLastRow - 1
For j = i + 1 To iLastRow
If InputArray(i) > InputArray(j) Then
varTemp = InputArray(j)
InputArray(j) = InputArray(i)
InputArray(i) = varTemp
End If
Next j
Next i
Case 2
iFirstRow = LBound(InputArray, 1)
iLastRow = UBound(InputArray, 1)
iFirstCol = LBound(InputArray, 2)
iLastCol = UBound(InputArray, 2)
If SortColumn InputArray(j, SortColumn) Then
For k = iFirstCol To iLastCol
varTemp = InputArray(j, k)
InputArray(j, k) = InputArray(i, k)
InputArray(i, k) = varTemp
Next k
End If
Next j
Next i
End Select
If Descending Then
OutputArray = InputArray
For i = LBound(InputArray, 1) To UBound(InputArray, 1)
k = 1 + UBound(InputArray, 1) - i
For j = LBound(InputArray, 2) To UBound(InputArray, 2)
InputArray(i, j) = OutputArray(k, j)
Next j
Next i
Erase OutputArray
End If
End Sub
This answer may have arrived a bit late to solve your problem when you needed to, but other people will pick it up when they Google for answers for similar problems.
当您需要时，这个答案可能来得有点晚，可以解决您的问题，但是其他人在 Google 搜索类似问题的答案时会选择它。
回答by Steve Jorgensen
The hard part is that VBA provides no straightforward way to swap rows in a 2D array. For each swap, you're going to have to loop over 5 elements and swap each one, which will be very inefficient.
困难的部分是 VBA 没有提供直接的方法来交换二维数组中的行。对于每次交换，您将不得不循环 5 个元素并交换每个元素，这将非常低效。
I'm guessing that a 2D array is really not what you should be using anyway though. Does each column have a specific meaning? If so, should you not be using an array of a user-defined type, or an array of objects that are instances of a class module? Even if the 5 columns don't have specific meanings, you could still do this, but define the UDT or class module to have just a single member that is a 5-element array.
我猜无论如何，二维数组确实不是您应该使用的。每列都有特定的含义吗？如果是这样，您不应该使用用户定义类型的数组或作为类模块实例的对象数组吗？即使这 5 列没有特定含义，您仍然可以这样做，但将 UDT 或类模块定义为只有一个 5 元素数组的成员。
For the sort algorithm itself, I would use a plain ol' Insertion Sort. 1000 items is actually not that big, and you probably won't notice the difference between an Insertion Sort and Quick Sort, so long as we've made sure that each swap will not be too slow. If you douse a Quick Sort, you'll need to code it carefully to make sure you won't run out of stack space, which can be done, but it's complicated, and Quick Sort is tricky enough already.
对于排序算法本身，我会使用普通的插入排序。1000 个项目实际上并没有那么大，您可能不会注意到插入排序和快速排序之间的区别，只要我们确保每次交换不会太慢。如果您确实使用快速排序，则需要对其进行仔细编码以确保不会耗尽堆栈空间，这是可以做到的，但它很复杂，而且快速排序已经足够棘手了。
So assuming you use an array of UDTs, and assuming the UDT contains variants named Field1 through Field5, and assuming we want to sort on Field2 (for example), then the code might look something like this...
因此，假设您使用一组 UDT，并假设 UDT 包含名为 Field1 到 Field5 的变体，并假设我们想要对 Field2 进行排序（例如），那么代码可能看起来像这样......
Type MyType
Field1 As Variant
Field2 As Variant
Field3 As Variant
Field4 As Variant
Field5 As Variant
End Type
Sub SortMyDataByField2(ByRef Data() As MyType)
Dim FirstIdx as Long, LastIdx as Long
FirstIdx = LBound(Data)
LastIdx = UBound(Data)
Dim I as Long, J as Long, Temp As MyType
For I=FirstIdx to LastIdx-1
For J=I+1 to LastIdx
If Data(I).Field2 > Data(J).Field2 Then
Temp = Data(I)
Data(I) = Data(J)
Data(J) = Temp
End If
Next J
Next I
End Sub
回答by swyx
sometimes the most brainless answer is the best answer.
有时候最无脑的答案就是最好的答案。
- add blank sheet
- download your array to that sheet
- add the sort fields
- apply the sort
- reupload the sheet data back to your array it will be the same dimension
- delete the sheet
- 添加空白表
- 将您的阵列下载到该工作表
- 添加排序字段
- 应用排序
- 将工作表数据重新上传回您的数组，它将具有相同的维度
- 删除工作表
tadaa. wont win you any programming prizes but it gets the job done fast.
塔达。不会为您赢得任何编程奖，但它可以快速完成工作。
回答by giveemheller
I'm going to offer up a slight bit of different code to Steve's approach.
我将为史蒂夫的方法提供一些不同的代码。
All valid points on efficiency, but to be frank.. when I was looking for a solution, I could have cared less about efficiency. Its VBA... I treat it like it deserves.
关于效率的所有有效点，但坦率地说..当我在寻找解决方案时，我本可以不那么关心效率。它的 VBA ......我像它应得的那样对待它。
You want to sort a 2-d array. Plain simple dirty simple insert sort that will accept a variable size array and sort on a selected column.
您想对二维数组进行排序。简单的简单脏简单插入排序，它将接受可变大小的数组并在选定的列上排序。
Sub sort_2d_array(ByRef arrayin As Variant, colid As Integer)
'theWidth = LBound(arrayin, 2) - UBound(arrayin, 2)
For i = LBound(arrayin, 1) To UBound(arrayin, 1)
searchVar = arrayin(i, colid)
For ii = LBound(arrayin, 1) To UBound(arrayin, 1)
compareVar = arrayin(ii, colid)
If (CInt(searchVar) > CInt(compareVar)) Then
For jj = LBound(arrayin, 2) To UBound(arrayin, 2)
larger1 = arrayin(i, jj)
smaller1 = arrayin(ii, jj)
arrayin(i, jj) = smaller1
arrayin(ii, jj) = larger1
Next jj
i = LBound(arrayin, 1)
searchVar = arrayin(i, colid)
End If
Next ii
Next i
End Sub
回答by Dan
For what it's worth (I can't show code at this point...let me see if I can edit it to post), I created an array of custom objects (so each of the properties come with whichever element its sorted by), populated a set of cells with each elements object properties of interest then used the excel sort function through vba to sort the column. Im sure theres probably a more efficient way of sorting it, rather than exporting it to cells, I just havent figured it out yet. This actually helped me a lot because when I needed to add a dimension, I just added a let and get property for the next dimension of the array.
对于它的价值（此时我无法显示代码......让我看看我是否可以编辑它以发布），我创建了一个自定义对象数组（因此每个属性都带有它排序的任何元素） ，使用感兴趣的每个元素对象属性填充一组单元格，然后通过 vba 使用 excel 排序功能对列进行排序。我确定可能有一种更有效的排序方式，而不是将其导出到单元格，我只是还没有弄清楚。这实际上对我帮助很大，因为当我需要添加一个维度时，我只是为数组的下一个维度添加了一个 let 和 get 属性。
回答by BumKneesOhYeah
You could make a separate array with 2 columns. Column 1 would be what your sorting on and 2 is what row is in other array. Sort this array by column 1 (only switching the two columns when swap). Then you could use the 2 arrays to process data as needed. Huge arrays could give you memory problems though
您可以创建一个包含 2 列的单独数组。第 1 列是您的排序依据，第 2 列是其他数组中的行。按第 1 列对此数组进行排序（仅在交换时切换两列）。然后您可以根据需要使用这 2 个数组来处理数据。巨大的数组可能会给你带来内存问题
回答by Marcel
It seems to me that the QuickSort code above can not handle spaces. I have an array with numbers and spaces. When I sort this array, the records with spaces are mixed up between the records with numbers. It took me a lot of time to find out, so probably it is good to keep it in mind when you use this code.
在我看来，上面的 QuickSort 代码不能处理空格。我有一个包含数字和空格的数组。当我对这个数组进行排序时，带空格的记录在带数字的记录之间混杂在一起。我花了很多时间才弄明白，所以当你使用这段代码时，最好记住这一点。
best, Marcel
最好的，马塞尔
