本文介绍了排序在VBA中multidimensionnal阵列的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
我已经定义了以下阵列暗淡myArray的（10,5），只要，并想对它进行排序。什么是做到这一点的最好的方法？
我将需要处理很多像1000×5矩阵的数据。它主要包含数字和日期，需要按照一定的列进行排序它
解决方案
下面是一个多列和VBA单柱快速排序，从发表吉姆·雷赫在Usenet一个code样品修改。
注：
您会注意到，我做一个的很多的防御性的编码比你在大多数的code样品看出来有网站：这是一个Excel论坛，你已经得到，如果你的源阵列来自（说）第三方实时市场数据源预见阵列空值和空值...或嵌套数组和对象。
空值和无效项被发送到列表的末尾。
您的通话将是：
快速排序MYARRAY ,,, 2
...传递到排序上2列并排除通过上面的可选参数和搜索域名的下限。
将帖子 - 固定在＆lt奇数格式毛刺; code＆GT;标签，这似乎有一个问题，在code注释的超链接。
我切除超链接是探测阵列的变体，VBA
公用Sub QuickSortArray（为ByRef SortArray为Variant，可选lngMin只要= -1，可选lngMax只要= -1，可选lngColumn只要= 0）
在错误恢复下一页 '排序的2维数组 SampleUsage：排序arrData按列3的内容
QuickSortArray arrData，3
发贴者吉姆·雷赫10/20/98 Excel.Programming 修改后，奈杰尔·赫弗南： ''逃生空变异比较失败
''防御性编码：检查输入 昏暗我只要
昏暗Ĵ只要
昏暗varMid为Variant
昏暗arrRowTemp为Variant
昏暗lngColTemp只要 如果为IsEmpty（SortArray）然后
退出小组
万一
如果INSTR（类型名（SortArray），（））下; 1然后'IsArray的（）是有点破：寻找在类型名称中括号
退出小组
万一
如果lngMin = -1然后
lngMin = LBOUND（SortArray，1）
万一
如果lngMax = -1然后
lngMax = UBound函数（SortArray，1）
万一
如果lngMin＆GT; = lngMax然后'无需排序
退出小组
万一 I = lngMin
J = lngMax varMid =空
varMid = SortArray（（lngMin + lngMax）\\ 2，lngColumn） 我们送'空'和无效的数据项的列表的末尾：
如果则IsObject（varMid）然后请注意，我们不检查则IsObject（SortArray（N）） - varMid *威力*拿起一个有效的默认成员或财产
I = lngMax
J = lngMin
elseif的的IsEmpty（varMid）然后
I = lngMax
J = lngMin
elseif的ISNULL（varMid）然后
I = lngMax
J = lngMin
elseif的varMid =那
I = lngMax
J = lngMin
elseif的VarType函数（varMid）= vbError然后
I = lngMax
J = lngMin
elseif的VarType函数（varMid）GT; 17以后
I = lngMax
J = lngMin
万一 虽然我＆LT; = j的
虽然SortArray（I，lngColumn）LT; varMid和I＆LT; lngMax
I = I + 1
WEND
虽然varMid＆LT; SortArray（J，lngColumn）和J＆GT; lngMin
当J = J - 1
WEND 如果我＆LT; = j的再
交换行
使用ReDim arrRowTemp（LBOUND（SortArray，2）向UBound函数（SortArray，2））
为lngColTemp = LBOUND（SortArray，2）向UBound函数（SortArray，2）
arrRowTemp（lngColTemp）= SortArray（I，lngColTemp）
SortArray（I，lngColTemp）= SortArray（J，lngColTemp）
SortArray（J，lngColTemp）= arrRowTemp（lngColTemp）
接下来lngColTemp
擦除arrRowTemp I = I + 1
当J = J - 1
万一
WEND 如果（lngMin＆LT; j）条然后调用QuickSortArray（SortArray，lngMin，J，lngColumn）
如果（I＆LT; lngMax）然后调用QuickSortArray（SortArray，我，lngMax，lngColumn）结束小组
...和单柱阵列版本：
公用Sub QuickSortVector（为ByRef SortArray为Variant，可选lngMin只要= -1，可选lngMax只要= -1）
在错误恢复下一页 排序一维数组 SampleUsage：排序arrData
QuickSortVector arrData
原帖由吉姆·雷赫10/20/98 Excel.Programming
修改后，奈杰尔·赫弗南：
''逃生与数组中的空变异比较失败
''防御性编码：检查输入 昏暗我只要
昏暗Ĵ只要
昏暗varMid为Variant
昏暗VARx前提为Variant 如果为IsEmpty（SortArray）然后
退出小组
万一
如果INSTR（类型名（SortArray），（））下; 1然后'IsArray的（）是有点破：寻找在类型名称中括号
退出小组
万一
如果lngMin = -1然后
lngMin = LBOUND（SortArray）
万一
如果lngMax = -1然后
lngMax = UBound函数（SortArray）
万一
如果lngMin＆GT; = lngMax然后'无需排序
退出小组
万一 I = lngMin
J = lngMax varMid =空
varMid = SortArray（（lngMin + lngMax）\\ 2） 我们送'空'和无效的数据项的列表的末尾：
如果则IsObject（varMid）然后请注意，我们不检查则IsObject（SortArray（N）） - varMid *威力*拿起一个默认成员或属性
I = lngMax
J = lngMin
elseif的的IsEmpty（varMid）然后
I = lngMax
J = lngMin
elseif的ISNULL（varMid）然后
I = lngMax
J = lngMin
elseif的varMid =那
I = lngMax
J = lngMin
elseif的VarType函数（varMid）= vbError然后
I = lngMax
J = lngMin
elseif的VarType函数（varMid）GT; 17以后
I = lngMax
J = lngMin
万一 虽然我＆LT; = j的 而SortArray（I）所述; varMid和I＆LT; lngMax
I = I + 1
WEND
虽然varMid＆LT; SortArray（J）和J＆GT; lngMin
当J = J - 1
WEND 如果我＆LT; = j的再
交换项目
VARx前提= SortArray（I）
SortArray（ⅰ）= SortArray（j）条
SortArray（J）= VARx前提 I = I + 1
当J = J - 1
万一 WEND 如果（lngMin＆LT; j）条然后调用QuickSortVector（SortArray，lngMin，J）
如果（I＆LT; lngMax）然后调用QuickSortVector（SortArray，我，lngMax）结束小组
我用冒泡了这种事情，但它会减慢，严重时，数组超过1024行之后。我下面包括供大家参考code：请注意，我还没有提供的源$ C $ C为ArrayDimensions，所以除非你重构它，这将不能编译你 - 或分割出来成为'阵'和'矢量版本。
公用Sub冒泡（为ByRef InputArray，可选SortColumn为整数= 0，可选降序由于布尔= FALSE）
排序1或2维数组。
昏暗iFirstRow作为整数
昏暗iLastRow作为整数
昏暗iFirstCol作为整数
昏暗iLastCol作为整数
昏暗我作为整数
昏暗Ĵ作为整数
昏暗的K作为整数
昏暗varTemp为Variant
昏暗OutputArray为Variant昏暗iDimensions作为整数iDimensions = ArrayDimensions（InputArray） 选择案例iDimensions
情况1 iFirstRow = LBOUND（InputArray）
iLastRow = UBound函数（InputArray） 对于i = iFirstRow要iLastRow - 1
对于J = + 1 iLastRow
如果InputArray（一）> InputArray（J）然后
varTemp = InputArray（J）
InputArray（J）= InputArray㈠
InputArray（ⅰ）= varTemp
万一
下面j
接下来，我 案例2 iFirstRow = LBOUND（InputArray，1）
iLastRow = UBound函数（InputArray，1） iFirstCol = LBOUND（InputArray，2）
iLastCol = UBound函数（InputArray，2） 如果SortColumn InputArray（J，SortColumn）然后
对于k = iFirstCol要iLastCol
varTemp = InputArray（J，K）
InputArray（J，K）= InputArray（I，K）
InputArray（I，K）= varTemp
下面k
万一
下面j
接下来，我 结束选择
如果遂降 OutputArray = InputArray 对于i = LBOUND（InputArray，1）UBound函数（InputArray，1） K = 1 + UBound函数（InputArray，1） - 我
对于j = LBOUND（InputArray，2）向UBound函数（InputArray，2）
InputArray（I，J）= OutputArray（K，J）
下面j
接下来，我 擦除OutputArray 万一
结束小组
这答案可能已经到达有点晚了，当你需要解决你的问题，但其他人将它捡起来，他们在谷歌针对类似的问题的答案。
I have defined the following Array Dim myArray(10,5) as Long and would like to sort it. What would be the best method to do that?
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
解决方案
Here's a multi-column and a single-column QuickSort for VBA, modified from a code sample posted by Jim Rech on Usenet.
Notes:
You'll notice that I do a lot more 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.
Empty values and invalid items are sent to the end of the list.
Your call will be:
QuickSort MyArray,,,2...Passing '2' as the column to sort on and excluding the optional parameters that pass the upper and lower bounds of the search domain.
[EDITED] - fixed an odd formatting glitch in the <code> tags, which seem to have a problem with hyperlinks in code comments.
The Hyperlink I excised was 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.
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.
这篇关于排序在VBA中multidimensionnal阵列的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！