[ExcelVBA]⾃定义排序的三种⽅法
诸君好，前前期我们聊了VBA编程和数据的常规排序……VBA常⽤⼩代码105：Rang对象的排序操作……
今天我们再聊下⾃定义排序……
何谓⾃定义排序，就是按指定的顺序对数据源进⾏排序呗……
今⼀共分享了三种⽅法。
第1种⽅法是系统⾃带的OrderCustom，优点是代码简洁，缺点是⾃定义序列有字符长度限制（255个）。
第2种⽅法是字典+数组设置序列号，再使⽤了辅助列进⾏排序。优点是不会破坏单元格的形式和结构，⽐如单元格中存在的公式、背景等。第3种⽅法是只使⽤字典+数组，借助简单桶排序的技巧，直接对数据在数组中进⾏排序。优点是效率较⾼，缺点是会破坏单元格的结构，⽐如消除公式等。
（第1种建议掌握，第2种建议了解，第3种……能懂就懂，不懂先放着吧~）
举个例⼦。
如下图所⽰，A:C列是数据源。
现需要根据E列所指定的部门先后顺序，对数据源进⾏重新排序，如果部门不在指定序列内，则排放在数据源末尾。
排序结果如下图。
第1种⽅法代码如下：
Sub FreeSort()
'eh技术论坛 VBA编程学习与实践看见星光
Dim n&, rng As Range
Set rng = Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row)
Application.AddCustomList (rng)
'增加⼀个⾃定义序列，该参数除了⽀持单元格对象，也⽀持数组。
n = Application.CustomListCount
'⾃定义序列的数⽬
Range("a:c").Sort key1:=[a1], order1:=xlAscending, Header:=xlYes, ordercustom:=n + 1
'使⽤⾃定义排序，ordercustom指定使⽤哪个⾃定义序列排序。
'当使⽤⾃定义排序时，需要将OrderCustom参数设置为指定的序列在⾃定义列表中的顺序加1
Application.DeleteCustomList n
'删除新增的⾃定义序列
End Sub
第2种⽅法代码如下：
Sub DicSort()
Dim d As Object, r, i&, arr, brr
Set d = CreateObject("ing.dictionary")
r = Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row).Value
For i = 1 To UBound(r)
d(r(i, 1)) = i '⽬标序列循环装⼊字典，序号作为item
Next
arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row)
'数据源装⼊数组arr
ReDim brr(1 To UBound(arr), 1 To 1)
'声明数组brr装原部门在指定序列中的序号
For i = 1 To UBound(arr)
ists(arr(i, 1)) Then
brr(i, 1) = d(arr(i, 1)) '将原部门在指定序列中的序列号装⼊brr
Else
brr(i, 1) = "指定序列不存在"
End If
Next
[d:d].Insert
'在D列插⼊⼀列
[d2].Resize(UBound(brr), 1) = brr
'新的序列号放⼊D列
Range("a:d").Sort key1:=[d1], order1:=xlAscending, Header:=xlYes 'D列升序排序
[d:d].Delete '删除D列
Set d = Nothing
End Sub
第3种⽅法代码如下：
Sub DicArrSort()
'eh技术论坛 VBA编程学习与实践看见星光
Dim d As Object, i&, n&, x&, k&, j&
Dim r, arr, brr, crr
Set d = CreateObject("ing.dictionary")
'后期绑定字典
r = Range("e2:e" & Cells(Rows.Count, "e").End(xlUp).Row).Value
vba编程技巧
For i = 1 To UBound(r)
d(r(i, 1)) = i '⽬标序列循环装⼊字典，序号作为item
Next
arr = Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row)
'数据源装⼊数组
ReDim brr(1 To d.Count + 1, 1 To 1)
'brr数组⽤于按序号装数组arr的⾏号，类似于桶排序的桶
For i = 1 To UBound(arr)
ists(arr(i, 1)) Then
'如果字典中存在相关部门……
n = d(arr(i, 1))
'该部门在指定序列中的序号
brr(n, 1) = brr(n, 1) & "," & i
'将该部门在arr中的⾏号装⼊数组brr对应的序号⾏
Else
brr(UBound(brr), 1) = brr(UBound(brr), 1) & "," & i
'如果字典中不存在，放⼊数组brr最后⼀⾏
End If
Next
ReDim crr(1 To UBound(arr), 1 To UBound(arr, 2))
'数组crr放排序后的结果
For i = 1 To UBound(brr)
If brr(i, 1) <> "" Then
'如果不为空，则有符合指定排序条件的关键词
r = Split(brr(i, 1), ",")
'将brr该位置储存的⾏号取出
For x = 1 To UBound(r)
k = k + 1 '累加⾏
For j = 1 To UBound(arr, 2)
crr(k, j) = arr(r(x), j)
'遍历指定⾏位置数组arr的值移到crr
Next
Next
End If
Next
Range("a2:c" & Cells(Rows.Count, 1).End(xlUp).Row) = crr
'将数组crr排序后的结果放回单元格区域
Set d = Nothing '释放字典
Erase arr: Erase brr: Erase crr
'释放数组
End Sub
题外话：
之前我们讲过，数组和字典是VBA处理数据的最佳利器，这是由于数组可以提⾼计算效率，字典可以关联多个数据源构建各种关系，因此这⾥再次对学习VBA的童鞋们提个⼩建议，不要在单元格⼯作簿等对象上浪费太多时间，那是熟能⽣巧的事物，数组和字典才是学习VBA的核⼼要义哦。

版权声明：本站内容均来自互联网，仅供演示用，请勿用于商业和其他非法用途。如果侵犯了您的权益请与我们联系QQ:729038198，我们将在24小时内删除。