[Excel VBA]自定义内涵排序的3种方法-英雄云拓展知识分享

诸君好，前前期我们聊了VBA编程和数据的常规排序……VBA经常使用小代码105：Rang对象的排序操作……

今天我们再聊下自定义内涵排序……

何谓自定义内涵排序，就是按指定的顺序对数据源进行排序呗……

今一共分享了3种方法。

第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)
If d.exists(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
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)
If d.exists(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的关键要义哦。

选择英雄云的云表单=选择更智能的Excel

在现代企业管理中，数据的高效管理和处理至关重要。随着信息技术的不断发展，英雄云的云表单已经成为了提高数据录入、管理和分析效率的不可或缺的工具。让我们来深入探讨英雄云-云表单的几大优势。

基础字段：多样性满足业务需求

英雄云的云表单中包括了各种基础字段，如单行文本、多行文本、数字输入框、单选框、复选框、下拉框、下拉复选框、日期时间、分割线等。这些字段的多样性使用户可以根据具体的业务需求，轻松进行文本、数据和时间信息的录入或修改。例如，您可以使用单行文本字段录入员工姓名、产品型号等，或者使用下拉框进行多选，根据不同情况选择更加方便的字段类型。

高级字段：提升工作效率

英雄云的云表单还提供了高级字段，如地址、图片、附件、手写签名、手机、子表、关联数据、关联查询以及流水号。这些高级字段在基础字段的基础上升级，可帮助用户完成一些琐碎的工作。例如，使用地址字段可以避免逐字打字，而流水号字段可以自动生成规律性的编号，非常适用于合同编号生成等场景。

部门成员字段：精确管理与通讯录的关联

英雄云的部门成员字段允许企业对各个部门的成员进行精确管理。用户可以通过部门成员字段获取通讯录中的部门成员信息，应用于记录报销人、报销部门等场景。这些成员字段还细分为成员单选和成员多选，可根据具体需求在通讯录中选择一个或多个成员。

聚合表：数据处理更智能

英雄云的聚合表功能用于对已存在的表单数据进行聚合计算，从而得到一张聚合表，后续其他表单可调用聚合表进行数据联动、关联查询和关联数据等操作完成数据处理。这一功能可应用于多种场景，如进销存管理、财务管理和门店零售管理等，帮助企业完成数据处理，提高工作效率。

表单权限设置：灵活管理数据访问

英雄云的表单权限设置允许用户根据企业的具体需求管理表单的访问和操作权限。用户可以根据系统权限或自定义权限对不同成员或团队进行权限设置，以确保数据的安全和合规性。这一功能使企业能够根据变化的业务需求和团队结构，实时调整权限设置。

自定义打印模板：文档输出更便捷

英雄云的云表单支持自定义打印模板，可将表单数据转换为可打印的Word文档。用户可以根据自己的需求进行排版和编辑，将产品规格说明书等文档轻松生成。这一功能提供了一种标准化的文档输出方式，简化了信息整理的过程。

综合来看，选择英雄云的云表单意味着选择更智能、更灵活、更高效的数据管理工具。无论是提高工作效率，精确管理数据，还是实现数据处理，英雄云的云表单都能满足您的多样化需求，助力您的业务发展。

如果您正在寻找一款强大的云表单工具，不妨考虑英雄云，它将为您带来更多的便捷和智能，助您事半功倍。

免责声明：

本网址（www.yingxiongyun.com）发布的材料主要源于独立创作和网友匿名投稿。此处提供的所有信息仅供参考之用。我们致力于提供准确且可信的信息，但不对材料的完整性或真实性作出任何保证。用户应自行验证相关信息的正确性，并对其决策承担全部责任。对于由于信息的错误、不准确或遗漏所造成的任何损失，本网址不承担任何法律责任。本网站所展示的所有内容，如文字、图像、标志、音频、视频、软件和程序等的版权均属于原创作者。如果任何组织或个人认为网站内容可能侵犯其知识产权，或包含不准确之处，请即刻联系我们进行相应处理。