「ExcelVBA」字典快速提取不重復項

L羅樂 2019-08-19

展開全文

本文轉(zhuǎn)載自公眾號：涂涂說Excel，作者：涂大榮。本文著作權(quán)歸原創(chuàng)作者所有，本人收藏此文僅作為學習之用，不作其他目的，如有侵權(quán)請聯(lián)系我刪除。

大家好！我是涂涂

「Excel VBA」的字典用法--快速提取不重復項。

今天的內(nèi)容

一個簡單例子，需要將“Sheet1”工作表當中A列不重復的職位提取出來，結(jié)果填入C列淡粉色區(qū)域中。處理這類問題的方法有很多，比如刪除重復項，高級篩選不重復項，Power Query，VBA等方法。

條條大路通羅馬，今天涂涂分享使用VBA的字典來處理這類問題。

關(guān)聯(lián)鏈接：

去重復項效果動圖

操作步驟

STEP 01

先將xlsx后綴的文件，另存為xlsm后綴的文件（xls后綴的不需要），否則工作簿關(guān)閉后代碼就消失了。

◆打開xlsx后綴的文件，【開始】【另存為】

◆保存類型選擇“Excel啟用宏的工作簿”

STEP 02

◆按【Alt F11】打開VBE編輯界面

◆左側(cè)選中該工作簿（看名稱），右鍵【插入】【模塊】

◆雙擊模塊，在代碼編輯窗口寫入代碼，關(guān)閉VBE界面

代碼

Sub 去重復項()
Dim i As Long, m As Long, k As Long
Dim Str As String
Dim dic As Object
Dim Arr
'A列非空行數(shù)，賦值給m
m = Worksheets('Sheet1').Cells(Rows.Count, 1).End(xlUp).Row
'字典
Set dic = CreateObject('scripting.dictionary')
'將數(shù)據(jù)裝入數(shù)組Arr
Arr = Range('A3:A' & m)
For i = 3 To UBound(Arr, 1)
'將數(shù)據(jù)轉(zhuǎn)換成字符串類型
Str = Arr(i, 1)
'如果字典中不存在Str，則
If Not dic.exists(Str) Then
'將Str作為關(guān)鍵字裝入字典
dic(Str) = ''
End If
Next
'清空C列內(nèi)容
[C:C].ClearContents
'以C3單元格為起始，調(diào)整數(shù)據(jù)寫入?yún)^(qū)域，寫入?yún)^(qū)域行數(shù)為dic.Count數(shù)目
'將字典關(guān)鍵字轉(zhuǎn)置后寫入?yún)^(qū)域
Range('C3').Resize(dic.Count, 1).Value = Application.Transpose(dic.keys)
'清空字典
Set dic = Nothing
End Sub