01 应用场景
场景：碰到一个Excel表，大概有50万行的数据，手头有差不多1万个待查询的信息，需要到50万行数据中去匹配。用了Excel自带的vlookup，大概要等5分钟才能将1万行的数据匹配好。根据每个人使用电脑的不同，耗时可能有些出入。但更多的时候，我们要查询数据往往超过1万行，而Excel的支持就不那么友好了。02 介绍
今天我来介绍下VBA的秘密武器——字典。
可能跟想象的不太一样，一本字典能称为秘密武器吗？其实，在这里更准确的说法应该是hashmap，它有一个非常好的优势，就是它的算法复杂度为O(1),注意这个1是个常数，也就是一，二，三的一。按算法来说，一般随着计算量的增加，我们要解决问题的难度也会加大。比如我们要在15个人里面看看有那几个人手里拿着旗子？可能一眼就能得到答案：3。但是如果现在有100万人呢？问题解决的难度就变得非常大了(O(n))。
O(1)的算法有一个非常的好的特性，不管数据多寡，它总是以固定的时间将问题的答案抛给提问者。就像面对一面魔镜，只要问一个问题，不管问题多难，魔镜都能瞬间给出答案。而hashmap，或字典就有这样的能力。
03 VBA字典
VBA的自带数据类型里并没有字典。需要我们自己引入。VBA有个古老的Scripting库，从Scripting中我们可以引入Dictionary，也就是常说的字典。引入语法如下
Set dict = CreateObject("Scripting.Dictionary")字典的主要属性如下
CompareMode Count Item key方法如下
Add Exists Items Keys Remove RemoveAllDictionary 跟我们日常使用的字典相似点如下：
Dictionary的键相当于我们字典要查的”词“
Dictionary的值相当于我们字典中查到”词的解释“
并且一个dictionary实例的键是不能重复的。
今天主要用到的属性跟方法是
Item=>对某个键赋值
Add=>增加一对键、值
Exists=>判断某个键是否存在
关于如何使用VBA的Dictionary，先告一段落，接下来要解决我们开头的那个应用场景
04 解决问题 第一个版本
在Excel表中模拟了差不多50万行的记录，有三个字段，分别是索引字段 索引值1 索引值2
这些数据都是随机生成的，并没有什么意义。其中索引字段是从26个英文子母中随机挑选了7个，索引值1跟2随机从1到200中取了个整数。
接下来，我从索引字段中随机抽取了差不多1万个待检索值，目标是在结果中显示内容。
首先，我们选中f4:f10000,在其中填入自定义函数NEWVLOOKUP，这个函数有三个参数，第一个是要查询的一列数组，也就是E4:E10000，第二个参数是目标索引的列，也就是A3:A500000,第三个参数就是要索引的内容，在这里我们选择索引自身，也就是1。
输完公式后使用Ctrl + Shift + Enter三键，让这个公式变成一个数组公式。
具体形式见下，在公式的左右会自动带上大括号。
在公式后台，我统计了整个过程的运行时间。具体见下
从运行时间来看，我们使用Dictionary的效率比vlookup要快10倍左右(35s VS 300s)，在日常的使用中使用这个公式可以快速地提高效率吧。
具体代码见下：
Public Function NEWVLOOKUP(query_array, lookup_array As Range, offset_col As Integer) As VariantApplication.ScreenUpdating = FalseDim start_timeDim ini_timeDim finish_timeDim rng As Range'统计时间start_time = Timer'生成字典Dim dict As ObjectSet dict = CreateObject("Scripting.Dictionary")'数据载入字典For Each rng In lookup_array If Not dict.exists(rng.Value) Then dict.Add rng.Value, rng.Offset(0, offset_col - 1).Value End IfNext'统计时间ini_time = TimerDim iDim temp_array()i = 1If TypeName(query_array) = "Range" Then ReDim temp_array(1 To query_array.Count, 1 To 1) For Each rng In query_array If dict.exists(rng.Value) Then temp_array(i, 1) = dict.Item(rng.Value) Else temp_array(i, 1) = "#N/A" End If i = i + 1 Next NEWVLOOKUP = temp_arrayElse If dict.exists(query_array) Then NEWVLOOKUP = dict.Item(query_array) Else NEWVLOOKUP = "#N/A" End IfEnd If'统计时间finish_time = TimerApplication.ScreenUpdating = True' 输出相关时间信息Dim processTimeDim totalTimeprocessTime = finish_time - ini_timetotalTime = finish_time - start_timeDebug.Print "字典生成时间:" & ini_time - start_time & "秒"Debug.Print "检索时间:" & processTime & "秒"Debug.Print "总时间:" & totalTime & "秒"Debug.Print "=========================="End Function'输出结果'字典生成时间:34.03516秒'检索时间:.6328125秒'总时间:34.66797秒'==========================emmmmm....
说好的O(1)算法，为啥用了整整35秒，哪里快了呀，喂。
05 解决问题 改进版本
从结果来看，虽然速度上去了。但是从解决问题的角度来说，速度依然慢得跟蜗牛一样。
从Python或JS的角度，加载200万的数据也不过区区几秒钟。这50万行数据VBA竟然用了35秒。
那么VBA到底在摸什么鱼？
看到结果，一开始我觉得无从下手。经过几天研究，我发现一个细节。就是字典加载时间并不是线性的。可能50万行加载出来的字典跟25万行加载的时间并不是一倍关系，而是比一倍要多。那就说明VBA加载字典，字典越大速度越慢，而如果我将字典拆开来几个小字典分别加载，那么从时间角度来看应该比单个大字典要快(也就是1+1<2)。示意图如下。
因为目标数据行数不是固定的，我需要设法找到一个方法来根据数据大小，动态地生成数量不等的字典，并组合成一个动态数组。
然后让表数据与动态数据进行关联，将键值存储到动态数组的字典中。
接着，将待查询的信息抛给字典组，让字典组从上到下进行查询。利用字典键值的快速响应的优势，进行查到即弹出的操作，并马上启动下一个循环，直至所有待查询的内容都有相应结果。
按照这个思路，我制做了改进版的程序。运行的结果如下：
具体的代码如下：
Public Function MULTIDICTVLOOKUP(query_array, lookup_array As Range, offset_col As Integer, Optional one_dict_rows As Long = 5000) As VariantApplication.ScreenUpdating = FalseDim look_array_size As Long '目标单元格行数Dim look_array_count As Long '在目标单元格中遍历的计数器'统计时间相关的声明Dim start_timeDim ini_timeDim finish_time'与字典和字典组成的数组相关的声明Dim dict_array() '储存字典的数组Dim dict '字典Dim dict_array_len As Integer '储存字典的数组大小Dim dict_array_count As Long '字典数组遍历时使用的计数器'统计时间'计时器开始计时'为了加快加载速度，按照一定行数对应的粗细度来生成多个字典，组成一个字典数组'多个字典的数量根据 one_dict_rows 变量来确定，默认5000行'根据测试， one_dict_rows 的行数不是越少越好，也不是越多越好， '行数越少生成的字典数组的长度较大，后期检索速度较慢 '行数越多生成字典的速度变慢，影响整个查询时间 '但总体来说检索字典的天然优势可以弥补生成字典速度 '实际可以根据情况来选择变量大小start_time = Timerlook_array_size = lookup_array.Countlook_array_count = 1dict_array_count = 1dict_array_len = WorksheetFunction.Ceiling(look_array_size / one_dict_rows, 1)Debug.Print "字典数组的大小"; dict_array_lenDebug.Print "一个字典处理多少行数据：" & one_dict_rowsReDim dict_array(1 To dict_array_len)For dict_array_count = 1 To dict_array_len Set dict_array(dict_array_count) = CreateObject("Scripting.Dictionary")Next'字典数组计数器需要第二次初始化，方便后面调用dict_array_count = 1'定义在遍历单元格时使用的range对象Dim rng As RangeFor Each rng In lookup_array If Not dict_array(dict_array_count).exists(rng.Value) Then dict_array(dict_array_count).Add rng.Value, rng.Offset(0, offset_col - 1).Value End If'根据遍历的结果切换储存的字典 If look_array_count = one_dict_rows Then dict_array_count = dict_array_count + 1 look_array_count = 0 End If look_array_count = look_array_count + 1Next'加载字典结束'统计时间ini_time = Timer'开始检索信息并返回结果给函数Dim i'申明临时数组用来储存查询结果，并返回给函数Dim temp_array()i = 1'根据输入参数的类型来处理检索'检索信息'1.查询的内容是range对象,进入range循环，返回的结果是一个数组 '1.1 在多个字典中，如果查到信息，跳出当前循环进入下个信息的检索 '1.2 检索万所有的字典，没有查到任何信息，返回"#N/A"结果'2.查询的内容是非range对象,直接返回查询结果 '如果输入参数是range对象If TypeName(query_array) = "Range" Then '根据查询数组的大小来重新申明临时数组 ReDim temp_array(1 To query_array.Count, 1 To 1) For Each rng In query_array For Each dict In dict_array If dict.exists(rng.Value) Then temp_array(i, 1) = dict.Item(rng.Value) '如果检索到相关信息，跳出当前查询的检索，进入下个信息的检索 GoTo exit_dict_array End If Next temp_array(i, 1) = "#N/A" exit_dict_array: i = i + 1 Next MULTIDICTVLOOKUP = temp_array'如果输入参数是非range对象Else If dict.exists(query_array) Then MULTIDICTVLOOKUP = dict.Item(query_array) Else MULTIDICTVLOOKUP = "#N/A" End IfEnd If'统计时间finish_time = TimerApplication.ScreenUpdating = True' 输出相关时间信息Dim processTimeDim totalTimeprocessTime = finish_time - ini_timetotalTime = finish_time - start_timeDebug.Print "字典生成时间:" & ini_time - start_time & "秒"Debug.Print "检索时间:" & processTime & "秒"Debug.Print "总时间:" & totalTime & "秒"Debug.Print "=========================="End Function'一个字典处理多少行数据：5000'字典生成时间:4.550781秒'检索时间:1.863281秒'总时间:6.414063秒'==========================最后总结
本次通过一个现实世界的案例来引入字典(Dictionary)，介绍了它强大的奥秘。在实际运用中遇到一些困难，并通过观察数据，发现改进的方法。最终实现了较快的数据索引(6.4s vs 300s)。
