VBA数组与字典解决方案第64讲（VBA数组与字典解决方案第64讲）

大家好，今日我们继续讲解VBA数组与字典解决方案，今日讲解第64讲内容：从字典提取数据后，汉字的笔画和拼音排序处理.

排序的方式,是我在本套书中重点介绍的内容,之前的讲解中我先后讲解了几种方法,但实际的工作中应用的最为普遍的仍是SORT排序,在这讲的内容中我将讲解一下当字典回填数据后用此方法进行按拼音和按笔画排序的两种方式.

实例的数据如下,在A列中有许多杂乱的数据,我们要利用字典来提出出不重复的数据,并反映每个数据出现的次数,然后回填数据,在回填的过程中按出现的次数进行排序.

思路分析:我们利用字典对数据进行排重处理,如果跟我学到这里,这应该不是难事了,在字典的加载时利用键来装数据,利用键值来装出现的次数,之后回填数据,回填数据时利用先回填键的方法,然后根据键的数据填键值,最后的是排序,把回填区域的数据全选,然后按照出现的次数后数据的性质进行排序,下面看我给出的代码:

Sub mynzsz_64() '第64讲 从字典提取数据后，汉字的笔画和拼音排序处理

Sheets("64").Select

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

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

For Each ran In Sheets("64").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

'清空区域待回填

[f:e].ClearContents

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

'回填键数据和键值数据

Sheets("64").[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

'在键和键值区域进行排序处理

rs = ActiveSheet.Range("e1").CurrentRegion.Rows.Count

Set rngs = ActiveSheet.Range(Cells(1, "e"), Cells(rs, "f"))

'rngs.Sort key1:=Cells(1, "f"), Order1:=xlDescending, key2:=Cells(1, "e"), _

order2:=xlAscending, Header:=xlYes, SortMethod:=xlStroke '笔画

'rngs.Sort key1:=Cells(1, "f"), Order1:=xlDescending, key2:=Cells(1, "e"), _

order2:=xlAscending, Header:=xlYes, SortMethod:=xlPinYin '拼音

rngs.Sort key1:=Range(Cells(1, "f"), Cells(rs, "f")), Order1:=xlDescending, key2:=Range(Cells(1, "e"), Cells(rs, "e")), _

order2:=xlAscending, Header:=xlYes, SortMethod:=xlPinYin '拼音

End Sub

代码的截图:

代码讲解:

1 上述过程实现了: 利用字典mydic对数据进行排重处理,在字典的加载时利用键来装数据,利用键值来装出现的次数,之后回填数据,回填数据时利用先回填键的方法,然后在键的区域建立循环，根据键的数据在字典中提取键值,最后的是排序,把回填区域的数据全选,然后按照出现的次数后数据的性质进行排序，这里我给出了三种方案，在下面我会一一讲解。

2 For Each ran In Sheets("64").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

上述代码实现了将数据装入字典，利用键来装数据，键值对应的是键出现的次数

3 '回填键数据和键值数据

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

上述代码实现了键数据的回填

4 For i = 1 To mydic.Count

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

Next

上述代码实现了键值的提取和回填

5 rs = ActiveSheet.Range("e1").CurrentRegion.Rows.Count

Set rngs = ActiveSheet.Range(Cells(1, "e"), Cells(rs, "f"))

设定排序区域。

6 'rngs.Sort key1:=Cells(1, "f"), Order1:=xlDescending, key2:=Cells(1, "e"), _

order2:=xlAscending, Header:=xlYes, SortMethod:=xlStroke '笔画

上述代码是实现按笔画排序

7 'rngs.Sort key1:=Cells(1, "f"), Order1:=xlDescending, key2:=Cells(1, "e"), _

order2:=xlAscending, Header:=xlYes, SortMethod:=xlPinYin '拼音

上述代码实现了按拼音排序。

8 rngs.Sort key1:=Range(Cells(1, "f"), Cells(rs, "f")), Order1:=xlDescending, key2:=Range(Cells(1, "e"), Cells(rs, "e")), _

order2:=xlAscending, Header:=xlYes, SortMethod:=xlPinYin '拼音

排序的另外一种写法。

9 Range对象的Sort方法可对值区域进行排序。其语法格式如下：

表达式： .Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)

该方法有很多参数，这些参数都可省略。各参数的含义如下：

① Key1：指定第一排序字段，作为区域名称（字符串）或Range对象；确定要排序的值。

② Order1：确定Key1中指定的值的排序次序，可设置为常量xlAscending（升序）或xlDescending（降序）。

③ Key2：第二排序字段。

④ Type：指定要排序的元素。

⑤ Order2：确定Key2中指定的值的排序次序。

⑥ Key3：第三排序字段。

⑦ Order3：确定Key3中指定的值的排序次序。

⑧ Header：指定第一行是否包含标题信息。

⑨ OrderCustom：指定在自定义排序次序列表中的基于1的整数偏移。

⑩ MatchCase：设置为True，则执行区分大小写的排序，设置为False，则执行不区分大小写的排序；不能用于数据透视表。

⑪ Orientation：指定以升序还是降序排序。可用常量xlSortColumns（按列排序）或xlSortRows（按行排序，这是默认值）。

⑫ SortMethod：指定排序方法。可用常量xlPinYin（按汉语拼音顺序排序，这是默认值）或xlStroke（按每个字符的笔画数排序）。

⑬ DataOption1：指定Key1中所指定区域中的文本的排序方式，可使用常量xlSortNormal（分别对数字和文本数据进行排序，这是默认值）或xlSortTextAsNumbers（将文本作为数字型数据进行排序）。

⑭ DataOption2：指定Key2中所指定区域中的文本的排序方式。

⑮ DataOption3：指定Key3中所指定区域中的文本的排序方式。

⑯ 使用Sort方法排序时，最多只能按3个关键字进行排序。

下面看代码的运行：

今日内容回向：

1 如何实现按拼音的排序？

2 如何实现按笔画的排序？

,