自从学会了VBA字典，VLOOKUP都不那么香了

　　上篇博文中，小爬曾多次为VBA字典带货。鼓励多用字典，可以让我们的VBA脚本工具执行更快。今天小爬来细聊一下VBA字典的具体应用！如果你有一定VBA基础，那么看完你一定会对VBA字典有全新的认识；如果你还是这方面的新手，也不影响点赞收藏哈。

　　字典，其实就是一些“键－值”对。使用起来非常方便，有类似于微型数据库的作用，可用于临时保存一些数据信息。在很多其它编程语言里，我们也常称它为MAP。

我们先来简单看下字典如何创建，又具备哪些属性和方法。

一、字典的创建，用的是WSH引用

Dim mydic As Object

Set mydic = CreateObject("Scripting.Dictionary")

 

二 、字典有哪些方法可供调用

　　它有Add、Exists、Keys、Items、Remove、RemoveAll，六个方法。

① Add 用于添加内容到字典中。如mydic.Add key, item 第一个参数为键，第二个参数为键对应的值；

② Exists 用于判断指定的关键词是否存在于字典（的键）中。如mydic.Exists(key)。如果存在，返回True，否则返回False。通常会在向字典中添加条目的时候使用，即先判断字典中是否已存在这个记录，如果不存在则新增，否则进行其它的操作；

③ Keys 获取字典所有的键，返回类型是数组。如mydic.Keys()；

④ Items 获取字典所有的值，返回类型是数组。如mydic.Items()；

⑤ Remove 从字典中移除一个条目，是通过键来指定的。mydic.Remove(key)如果指定的键不存在，会发生错误；

⑥ RemoveAll 清空字典。

 

三、字典有哪些属性

　　它有Count、Key、Item、ConpareMode四种属性，其中前三个属性较为常用。

① Count 用于统计字典中键－值对的数量。也可以简单理解为统计字典中键的个数；

② Key 用于更改字典中已有的键。如：myd.Key("oapp") = "Orange" 如果指定的键不存在，则会产生错误；

③Item 用于写入或读取字典中指定键的值，如果指定的键不存在，则会新增。如.Item("oapp") = 10。

 

有了这些基础知识，我们就可以解决下面这些常见的业务问题了。

场景一：对表格某列值进行去重

　　下图所示内容通过python的faker库进行自动生成，非真实数据，感兴趣的童鞋，可以自行安装该faker库，生成自己想要的测试样表数据。

　　我们可以利用Exists方法判断某个名字是否已存在于字典，不存在则调用Add方法添加该名字为字典的key，至于value，我们该场景并不关心，可以随便存入"""空字符串。最后再通过遍历mydic.keys()（得到一个存有所有key的一维数组）的每一个元素，逐个输出到另一列，也可以选择覆盖原则，达到去除重复项的效果。也可以将数组一次性写入一个单元格区域（range的长度需要跟字典的长度一致，否则无法写入成功），代码示例如下：

Sub removeDuplicates()
 Dim myDic As Object, i As Integer, sht As Worksheet, maxRow As Integer, totalCnt As Integer
 Set myDic = CreateObject("scripting.dictionary")
 Set sht = ThisWorkbook.Sheets("Sheet1")
 maxRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To maxRow
    If myDic.Exists(sht.Cells(i, 1).Value) = False Then
        myDic.Add sht.Cells(i, 1).Value, ""
    End If
 Next

'方法一，利用transpose转置函数将一维数组转为一个N行一列的多维数组，找一个同样尺寸的range接收这个数组
totalCnt = myDic.Count
sht.Range("D2:D" & totalCnt) = Application.Transpose(myDic.Keys())

'方法二，用for each方法直接遍历一维数组的每个元素，依次存入特定单元格
i = 2
For Each Name In myDic.Keys
    sht.Cells(i, 4).Value = Name
    i = i + 1
Next
End Sub

场景二：模拟VLOOKUP（HLOOKUP同理）的精确匹配

 　　假定此处，要根据Name来匹配Address，我们只需要先将姓名（key），地址（value，也就是Item）顺序存入字典，再根据Item方法读取某个Name对应的值。如果对应的Name在字典中没有找到，则address会返回空值，代码示例如下：

Sub myVlookup()
 Dim myDic As Object, i As Integer, sht As Worksheet, maxRow As Integer, totalCnt As Integer
 Application.ScreenUpdating = False
 Set myDic = CreateObject("scripting.dictionary")
 Set sht = ThisWorkbook.Sheets("Sheet1")
 maxRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To maxRow
    If myDic.Exists(sht.Cells(i, 1).Value) = False Then
        myDic.Add sht.Cells(i, 1).Value, sht.Cells(i, 3).Value
    End If
 Next

maxRow = sht.Cells(Rows.Count, 5).End(xlUp).Row '读取第五列的最后一行行号
For i = 2 To maxRow
    sht.Cells(i, 6).Value = myDic.Item(sht.Cells(i, 5).Value) '根据第五列的key，将对应的item写入第六列
Next
 Application.ScreenUpdating = True
End Sub

 

场景三：实现Vlookup不易实现的从右至左反向查找功能

　　假设很不凑巧，我们的【姓名】字段在【地址】字段后面，常规的Vlookup函数需要用到if还有数组 来实现，网上有很多相关资料，可惜公式对于新手而言，不是很容易理解，如果用字典来实现就太简单了，我们很容易在存入字典时调整列顺序，几乎没有多余的学习成本，代码如下：

Sub myReversalVlookup()
 Dim myDic As Object, i As Integer, sht As Worksheet, maxRow As Integer, totalCnt As Integer
 Application.ScreenUpdating = False
 Set myDic = CreateObject("scripting.dictionary")
 Set sht = ThisWorkbook.Sheets("Sheet1")
 maxRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To maxRow
    If myDic.Exists(sht.Cells(i, 3).Value) = False Then
        myDic.Add sht.Cells(i, 3).Value, sht.Cells(i, 1).Value
    End If
 Next

maxRow = sht.Cells(Rows.Count, 5).End(xlUp).Row '读取第五列的最后一行行号
For i = 2 To maxRow
    sht.Cells(i, 6).Value = myDic.Item(sht.Cells(i, 5).Value) '根据第五列的key，将对应的item写入第六列
Next
 Application.ScreenUpdating = True
End Sub

 

场景四：我们要根据【姓名】，匹配【地址】和【公司简称】

　　传统的方法，自然需要编写两个Vlookup公式，那么用字典来实现的话，同样传统的方法，我们需要两个字典（把它用两个字典分别查出地址和公司简称即可），这没啥难理解。如果我们要匹配的列数很多，则需要建立多个字典，难免语法上有些繁琐。如果想通过一个字典就实现查找多列的效果，你们想到偷懒的好法子了吗？

　　其实我们只需要将多列（value）加上特殊字符后拼接成一个value，最终取出来的时候，再基于这个特殊符号来split这个value，得到的数组每个元素其实就对应要查找的多列的值，此处小爬以同时查找地址和公司简称为例说明该trick。

示例代码如下：

Sub multiVlookup()
 Dim myDic As Object, i As Integer, sht As Worksheet, maxRow As Integer, totalCnt As Integer, values As String
 Application.ScreenUpdating = False
 Set myDic = CreateObject("scripting.dictionary")
 Set sht = ThisWorkbook.Sheets("Sheet1")
 maxRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
 For i = 2 To maxRow
    values = sht.Cells(i, 1).Value & "_" & sht.Cells(i, 2).Value '此处以"_"作为拼接字符，如果您觉得该字符可能出现在value中，可以换其它非常用字符来代替
    If myDic.Exists(sht.Cells(i, 3).Value) = False Then
        myDic.Add sht.Cells(i, 3).Value, values
    End If
 Next

maxRow = sht.Cells(Rows.Count, 5).End(xlUp).Row '读取第五列的最后一行行号
For i = 2 To maxRow
    values = myDic.Item(sht.Cells(i, 5).Value) '根据第五列的key，将对应的item写入第六列
    sht.Cells(i, 6).Value = Split(values, "_")(0) '存入split分段后的数组的第一个元素，即为地址
    sht.Cells(i, 7).Value = Split(values, "_")(1) '存入split分段后的数组的第二个元素，即为公司简称
Next
 Application.ScreenUpdating = True
End Sub

 

场景五：匹配某个key最后一次出现的value

　　传统的vlookup精确匹配，我们总是匹配到第一个值，这个我们的场景二方案中已有使用字典的实现代码。比如此例中，假设姓名存在重名，我们要匹配最后一次出现的某个【姓名】对应的【公司简称】，使用vlookup将会很难实现，但是当我们有了字典，你会发现，原来可以这么简单干脆就解决我们以为的痛点，示例代码如下：

Sub mylookup()
 Dim myDic As Object, i As Integer, sht As Worksheet, maxRow As Integer, totalCnt As Integer
 Application.ScreenUpdating = False
 Set myDic = CreateObject("scripting.dictionary")
 Set sht = ThisWorkbook.Sheets("Sheet1")
 maxRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
 '
 For i = 2 To maxRow '不进行exists判断，那么如果某个key反复出现，则对应的value则会被后来值进行覆盖
    myDic(sht.Cells(i, 1).Value) = sht.Cells(i, 3).Value '写入字典，如果有，则覆盖原来值
 Next

maxRow = sht.Cells(Rows.Count, 5).End(xlUp).Row '读取第五列的最后一行行号
For i = 2 To maxRow
    sht.Cells(i, 6).Value = myDic.Item(sht.Cells(i, 5).Value)
Next
 Application.ScreenUpdating = True
End Sub

 

　　其实利用vba字典来实现数据查找的案例远不止这些，小爬列举的五个场景，不过是其广阔应用的冰山一角。

　　希望通过对字典的功能和案例的介绍，能够对童鞋们今后的办公自动化工作有所启发，能够善用字典，在实际工作中真正用起来，感受它的魅力~~

快来扫码关注我的公众号 获取更多爬虫、数据分析的知识！