利用工作表函数，对字典键进行排序并给出对应重复个数

大家好，今日我们继续讲解VBA数组与字典解决方案，今日的内容是第58讲，利用工作表函数，对字典的键进行排序,并给出对应的重复个数。

对于排序，大家并不陌生，在之前的讲解中，我也讲了利用sort进行排序的方法。今日我们讲解利用工作表函数对数值排序.对于工作函数，我这讲利用了LARGE,还可以使用SMALL.都是可以的，这类函数在实际的应用中也十分方便。

实例，我们看下面的数据，在A列中有若干多的数据，我们要对这些数值进行排序，并将重复的次数记录。

思路分析：我们要先将数据放到字典中，放的同时利用键值进行累计出现重复的次数，然后取出键和键值放到对应的数组中，同时再建立一个数组用于存放排序的结果，然后在数组中提取数值，提取的时候是按照从大到小顺序进行。并将结果放到数组中，最后回填数据。下面看我给出的代码：

Sub mynzsz_58() '第58讲 利用工作表函数，对字典的键进行排序,并给出对应的重复个数

Dim ran

Sheets("58").Select

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

'将数据放入字典中，并计数

For Each ran In Sheets("58").Range("a2:a" & Range("a2").End(xlDown).Row)

If ran.Value <> "" Then

If Not mydic.exists(ran.Value) Then

mydic.Add ran.Value, 1 '初始值为1

Else

mydic(ran.Value) = mydic(ran.Value) + 1 '重复时累加

End If

End If

Next

'将字典的键和键值，取出，放到数组中

k = mydic.keys: T = mydic.items

'新建一个数组，用于放排序的结果

ReDim X(1 To mydic.Count, 1 To 2)

For i = 1 To mydic.Count

X(i, 1) = Application.Large(k, i) '按最大值的先后将数据放到数组中

X(i, 2) = mydic(X(i, 1)) '提取相应的键值

Next

[e:f].Clear

[e1] = "排序": [f1] = "重复次数"

Sheets("58").[e2].Resize(mydic.Count, 2) = X

Set mydic = Nothing

End Sub

代码截图：

代码讲解：

1 上述代码实现将数据放到字典mydic中，放的同时利用键值进行累计出现重复的次数，然后取出键和键值放到对应的数组k,t中备用，同时再建立一个数组x用于存放排序的结果，然后在数组k中提取数值，提取是按照从大到小的顺序进行。并将结果放到数组x中，最后回填数据。

2 For Each ran In Sheets("58").Range("a2:a" & Range("a2").End(xlDown).Row)

If ran.Value <> "" Then

If Not mydic.exists(ran.Value) Then

mydic.Add ran.Value, 1 '初始值为1

Else

mydic(ran.Value) = mydic(ran.Value) + 1 '重复时累加

End If

End If

Next

上述代码在将数据放到字典中，注意这里有一个是否重复的判定：Not mydic.exists(ran.Value)

3 '将字典的键和键值，取出，放到数组中

k = mydic.keys: T = mydic.items

此处要注意的是k 和 t 的含义，是一个一维数组，之后的代码要在k中建立一个循环提取数值。

4 For i = 1 To mydic.Count

X(i, 1) = Application.Large(k, i) '按最大值的先后将数据放到数组中

X(i, 2) = mydic(X(i, 1)) '提取相应的键值

Next

上述代码按照i值在k中提取数据，i是从小到大排序的，所以LARGE函数会相应出现从大到小的排序，Application.Large(k, i)，要注意这个工作表函数的用法. 将mydic(X(i, 1)) 提取相应的键值放到X(i, 2)中

5 Sheets("58").[e2].Resize(mydic.Count, 2) = X

上述代码回填数据

下面看代码的运行：

今日内容回向：

1 如何实现键的排序？

2 利用上述工作表函数如何实现从小到大的排序？