new-june

  上篇博文中,小爬曾多次为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的长度需要跟字典的长度一致,否则无法写入成功),代码示例如下:

 1 Sub removeDuplicates()
 2  Dim myDic As Object, i As Integer, sht As Worksheet, maxRow As Integer, totalCnt As Integer
 3  Set myDic = CreateObject("scripting.dictionary")
 4  Set sht = ThisWorkbook.Sheets("Sheet1")
 5  maxRow = sht.Cells(Rows.Count, 1).End(xlUp).Row
 6  For i = 2 To maxRow
 7     If myDic.Exists(sht.Cells(i, 1).Value) = False Then
 8         myDic.Add sht.Cells(i, 1).Value, ""
 9     End If
10  Next
11 
12 \'方法一,利用transpose转置函数将一维数组转为一个N行一列的多维数组,找一个同样尺寸的range接收这个数组
13 totalCnt = myDic.Count
14 sht.Range("D2:D" & totalCnt) = Application.Transpose(myDic.Keys())
15 
16 \'方法二,用for each方法直接遍历一维数组的每个元素,依次存入特定单元格
17 i = 2
18 For Each Name In myDic.Keys
19     sht.Cells(i, 4).Value = Name
20     i = i + 1
21 Next
22 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字典来实现数据查找的案例远不止这些,小爬列举的五个场景,不过是其广阔应用的冰山一角。

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

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

 

 

分类:

技术点:

相关文章: