使用字典快速擷取唯一值與重複值【單個字典對象】

在以前的部落格《使用字典快速擷取唯一值與重複值（交集與并集）》使用多個字典對象擷取交集與并集，最近有同學提問，是否可以隻使用一個字典對象實作相同的功能，對于有“程式設計潔癖”的同學來說，可能不喜歡使用多個字典對象。

執行個體需求：表1和表2為兩個名單，不同班級有同名的學生，例如表2中有兩個小王（截圖中黃色單元格），是以需要使用

班級+姓名

作為學生的唯一識别辨別，現在需要統計如下三個清單

• 表1有表2無
• 表1無表2有
• 兩表共有

示例代碼如下。

Sub demo()
    Set objDic = CreateObject("scripting.dictionary")
    arr = ActiveSheet.Range("a2").CurrentRegion
    For i = 3 To UBound(arr)
        sKey = arr(i, 2) & "|" & arr(i, 3)
        objDic(sKey) = 1
    Next
    brr = ActiveSheet.Range("e2").CurrentRegion
    For i = 3 To UBound(brr)
        sKey = brr(i, 2) & "|" & brr(i, 3) 
        If objDic.Exists(sKey) Then 
            objDic(sKey) = 3
        Else
            objDic(sKey) = 2
        End If
    Next
    range("I3:P31").clearcontents
    iRow = 3: lRow = 3: oRow = 3
    For Each strKey In objDic.Keys
        If objDic(strKey) = 1 Then
            ActiveSheet.Cells(iRow, "I").Resize(, 2) = Split(strKey, "|")
            iRow = iRow + 1
        ElseIf objDic(strKey) = 2 Then
            ActiveSheet.Cells(lRow, "L").Resize(, 2) = Split(strKey, "|")
            lRow = lRow + 1
        ElseIf objDic(strKey) = 3 Then
            ActiveSheet.Cells(oRow, "O").Resize(, 2) = Split(strKey, "|")
            oRow = oRow + 1
        End If
    Next
    Set objDic = Nothing
End Sub
           

【代碼解析】

第1行代碼建立字典對象。

第3行代碼将表1讀取到數組中。

第4~7行代碼循環周遊表1中的資料。

第5行代碼将班級和姓名組合作為字典對象的鍵，其中使用豎線作為分隔符，以便于回寫資料時進行拆分。

第6行代碼将鍵加入到字典中，其值設定為1。

第8~16行處理表2的資料，主要結構同上。

第11行代碼判斷鍵是否存在于字典中。

• 如果存在，說明是兩表共用的資料，第12行代碼将值修改為3。
• 如果不存在，說明是表2獨有的資料，第14行代碼将值修改為2。

至此，将全部資料加載到字典對象中，根據鍵值（

1,2,3

）可以區分該學生屬于哪個清單。

第17行代碼清空結構單元格區域。

第18行代碼設定3個清單的起始行為第3行。

第19~30行代碼循環周遊字典對象中的鍵。

第20~29行代碼根據鍵值，分别寫入I、L或者O列相應的單元格中。

其中，

resize(, 2)

将單元格區域擴充至一行兩列，即兩個單元格。

Split

函數将拆分班級和姓名，用于寫入單元格區域。

第30行代碼釋放對象變量所占用的系統資源。

字典對象很靈活，充分利用其特性可以實作很多功能，希望本文對于各位同學有幫助。