字典添加数据_数组与字典第66讲：从字典提取数据后，实现自定义排序

第66讲 从字典提取数据后，实现自定义排序

大家好，今日我们继续讲解VBA数组与字典解决方案，今日讲解第66讲内容：从字典提取数据后，实现自定义排序.

对于排序而言,我们在上节讲了乱序，是工作中经常会用到的，今日我们讲解自定义排序，什么是自定义排序呢？和乱序不同，乱序是打乱顺序，而自定义排序是要按照给定的顺序排序，

也许有些人不理解，为什么会有这种排序呢？给大家举个实例，在计划经济时代，住房是分配的，当某个单位要分配新建住宅了，要对单位的职工工龄什么的排序，按照排名进行分派，但是，很多情况是有特例的，比如劳动模范，特殊贡献者，这类人要优先排，剩下的职工再大排队分配，那么这些特例就是自定义排序了。

我们看下面的实例，在A列中有很多数据，我们要提取出不重复的名称和出现的次数，在出现的城市名称中，我们要把有排序要求的几个城市名称按给定的顺序放在最前面，其余的城市再大排队。怎么做到？

思路分析：

先用字典提出城市的名称和出现的次数，放到填充区域，然后利用字典对自定义排序的城市名进行装载，键值就设定为排序的顺序，之后在回填区域找到有自定义排序要求的城市名，在后面注明排序的要求（键值），之后按排序要求的列进行排序，排序后，将这列数据删除，这样就完成了我们的目的，下面看我给出的代码；

Sub mynzsz_66() '第66讲 从字典提取数据后，实现自定义排序

Sheets("66").Select

Set mydic = CreateObject("Scripting.Dictionary") '字典

'数据赋值给字典，同时统计出现的次数

For Each ran In Sheets("66").Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)

If ran.Value <> "" Then

If Not mydic.exists(ran.Value) Then

mydic.Add ran.Value, 1

Else

mydic(ran.Value) = mydic(ran.Value) + 1

End If

End If

Next

'清空区域待回填

[g:e].ClearContents

Sheets("66").Range("e1") = "数据": Sheets("66").Range("f1") = "次数"

'回填键数据和键值数据

Sheets("66").[E2].Resize(mydic.Count) = WorksheetFunction.Transpose(mydic.keys)

For I = 1 To mydic.Count

Cells(I + 1, "f") = mydic(Cells(I + 1, "e").Value)

Next

'自定义排序序列,排序的基准

Set mydic = Nothing

Set mydic = CreateObject("Scripting.Dictionary") '字典

rs = Range("C1").End(xlDown).Row

For I = 2 To rs

mydic(Cells(I, "C").Value) = I - 1

Next

'添加自定义排序序列。

rs = Range("E1").End(xlDown).Row

For I = 2 To rs

Cells(I, "g") = mydic(Cells(I, "E").Value)

Next

'实现自定义排序

Set Rng = Range(Cells(1, "e"), Cells(rs, "g"))

Rng.Sort key1:=Range(Cells(1, "g"), Cells(rs, "g")), Order1:=xlAscending, Header:=xlYes

'清除添加的自定义序列

Columns("g").Clear

Set mydic = Nothing

End Sub

代码截图：

代码讲解：

1 上述代码实现了按自定义排序要求进行排序。首先将数据装入字典mydic,同时计算重复次数装入键值，回填数据，并清空字典。然后，将字典再次装载，这次是装自定义排序的数据，键值用排序要求的顺序，这里用行数代替；最后，在回填数据区域G列按照E列的值获取应该排序的顺序值，设定排序区域，按照G列进行排序，排序后删除G列数据。

2 '数据赋值给字典，同时统计出现的次数

For Each ran In Sheets("66").Range("a2:a" & Cells(Rows.Count, 1).End(xlUp).Row)

If ran.Value <> "" Then

If Not mydic.exists(ran.Value) Then

mydic.Add ran.Value, 1

Else

mydic(ran.Value) = mydic(ran.Value) + 1

End If

End If

Next

'清空区域待回填

[g:e].ClearContents

Sheets("66").Range("e1") = "数据": Sheets("66").Range("f1") = "次数"

'回填键数据和键值数据

Sheets("66").[E2].Resize(mydic.Count) = WorksheetFunction.Transpose(mydic.keys)

For I = 1 To mydic.Count

Cells(I + 1, "f") = mydic(Cells(I + 1, "e").Value)

Next

上述代码利用字典提取不重复的数据，后回填，之前总有讲解，不再多说了

3 '自定义排序序列,排序的基准

Set mydic = Nothing

Set mydic = CreateObject("Scripting.Dictionary") '字典

rs = Range("C1").End(xlDown).Row

For I = 2 To rs

mydic(Cells(I, "C").Value) = I - 1

Next

上述语句将自定义排序的序列装入字典，同时键值取I-1即要排序的值

4 '添加自定义排序序列。

rs = Range("E1").End(xlDown).Row

For I = 2 To rs

Cells(I, "g") = mydic(Cells(I, "E").Value)

Next

在回填区域的G列，根据E列的值填上应排的序号。

5 '实现自定义排序

Set Rng = Range(Cells(1, "e"), Cells(rs, "g"))

Rng.Sort key1:=Range(Cells(1, "g"), Cells(rs, "g")), Order1:=xlAscending, Header:=xlYes

'清除添加的自定义序列

Columns("g").Clear

上述代码在E:G列排序，排序的规则是按G列，然后删除G列的值。

下面看代码的运行：

我们改变一下自定义序列的值，再次运行：

今日内容回向：

1 如何实现自定义排序？

2 代码中两次应用了字典，意义有何不同？