自從學會了VBA字典，VLOOKUP都不那麼香了

NewJune發表於2022-01-18

　　上篇博文中，小爬曾多次為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字典來實現資料查詢的案例遠不止這些，小爬列舉的五個場景，不過是其廣闊應用的冰山一角。

　　希望通過對字典的功能和案例的介紹，能夠對童鞋們今後的辦公自動化工作有所啟發，能夠善用字典，在實際工作中真正用起來，感受它的魅力~~

快來掃碼關注我的公眾號 獲取更多爬蟲、資料分析的知識！

 

 

相關文章