大家好，今日我们继续讲解数组与字典解决方案，今日讲解第47讲：利用字典和数组，实现按指定规则的排序。随着字典讲解的深入,我们发现字典真的很神奇,在VBA代码中,给人以十分清爽的感觉,在这套数组与字典解决方案中,我会尽可能的把经常用到的实例多多讲解给大家,让大家对于字典的理解更加深入.虽然这块内容利用其它方案都可以实现,但是字典确实能大大简化我们的代码.让我们对于VBA的理解更深入.
今日实例是实现按指定规则的排序,为什么会有这个课题呢?对于职场中的我们经常会用到数据分析,往往数据来源不一致,同样项目,由于来源不同,往往排序的方式不同,而且有时候要求提交数据的排序并不是EXCEL自带功能可以解决的,这个时候怎么办?我们依然可以用字典来帮助解决,我们看下面的数据：
大家注意到，在A,B列中，给出了排序的规则，在D,E,F列中是提供的报表数据，但这个数据报表的排序不符合A,B列的排序规则，我们要实现的是把报表数据按照固定的规则来排序，如何做到呢？下面看我给出的代码：
Sub mynzsz_47() '第47讲 利用数组和字典，实现按指定规则的排序
Sheets("47").Select
Dim mybrr()
'建立字典
Set myDic = CreateObject("Scripting.Dictionary")
'把数据装入数组
myarr = Range("a2:f" & [a65536].End(xlUp).Row)
'动态数组的再分配
ReDim mybrr(1 To UBound(myarr), 1 To 4)
'字典的赋值，也是排序规则的建立
For i = 1 To UBound(myarr)
myDic(CStr(myarr(i, 1))) = i
Next i
'给定数据的排序，其实是把给定的数据，按照字典建立的规则放到另外一个数组中
For i = 2 To Cells(65536, 4).End(xlUp).Row
If myDic(CStr(myarr(i - 1, 4))) <> "" Then
mybrr(myDic(CStr(myarr(i - 1, 4))), 1) = myarr(i - 1, 4)
mybrr(myDic(CStr(myarr(i - 1, 4))), 2) = myarr(i - 1, 5)
mybrr(myDic(CStr(myarr(i - 1, 4))), 3) = myarr(i - 1, 6)
End If
Next i
'数据的回填
[d2].Resize(UBound(mybrr), 3) = mybrr
End Sub
代码的截图：
代码讲解：
1 上述代码实现了数据按指定规则排序，只要给定规则，就可以实现数据的自定义排序。
2 '把数据装入数组
myarr = Range("a2:f" & [a65536].End(xlUp).Row)
上述代码将数据放到数组中，在实际应用中，也可以将规则数据和报表数据分别放在不同的数组中。
3 '动态数组的再分配
ReDim mybrr(1 To UBound(myarr), 1 To 4)
这个动态数组是用来装排序完成的数据的。
4 '字典的赋值，也是排序规则的建立
For i = 1 To UBound(myarr)
myDic(CStr(myarr(i, 1))) = i
Next i
大家要注意这几行代码即给字典赋值同时又用键值定义了排序的规则，大家可以理解一下。
5 '给定数据的排序，其实是把给定的数据，按照字典建立的规则放到另外一个数组中
For i = 2 To Cells(65536, 4).End(xlUp).Row
If myDic(CStr(myarr(i - 1, 4))) <> "" Then
mybrr(myDic(CStr(myarr(i - 1, 4))), 1) = myarr(i - 1, 4)
mybrr(myDic(CStr(myarr(i - 1, 4))), 2) = myarr(i - 1, 5)
mybrr(myDic(CStr(myarr(i - 1, 4))), 3) = myarr(i - 1, 6)
End If
Next i
在上述代码中，首先在字典中查找报表数据在字典中是否存在，如果存在，那么就存放到存放排序结果的数组中，但是放在结果数组中的时候，存放顺序是键值给出的顺序。
6 '数据的回填
[d2].Resize(UBound(mybrr), 3) = mybrr
将排序的结果回填到数据区域.
下面看代码的运行结果：
今日内容回向：
1 如何实现报表数据按指定规则的排序？
2 myDic(CStr(myarr(i, 1))) = I 的意义是什么？