「ExcelVBA」字典快速提取不重复项

本文转载自公众号：涂涂说Excel，作者：涂大荣。本文著作权归原创作者所有，本人收藏此文仅作为学习之用，不作其他目的，如有侵权请联系我删除。

大家好！我是涂涂

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

今天的内容

一个简单例子，需要将“Sheet1”工作表当中A列不重复的职位提取出来，结果填入C列淡粉色区域中。处理这类问题的方法有很多，比如删除重复项，高级筛选不重复项，Power Query，VBA等方法。

条条大路通罗马，今天涂涂分享使用VBA的字典来处理这类问题。

关联链接：

提取不重复项，这方法你用过吗？

去重复项效果动图

操作步骤

STEP 01

先将xlsx后缀的文件，另存为xlsm后缀的文件（xls后缀的不需要），否则工作簿关闭后代码就消失了。

◆打开xlsx后缀的文件，【开始】【另存为】

◆保存类型选择“Excel启用宏的工作簿”

STEP 02

◆按【Alt F11】打开VBE编辑界面

◆左侧选中该工作簿（看名称），右键【插入】【模块】

◆双击模块，在代码编辑窗口写入代码，关闭VBE界面

代码

1. Sub 去重复项()

2.    Dim i As Long, m As Long, k As Long

3.    Dim Str As String

4.    Dim dic As Object

5.    Dim Arr

6.    'A列非空行数，赋值给m

7.    m = Worksheets('Sheet1').Cells(Rows.Count, 1).End(xlUp).Row

8.    '字典

9.    Set dic = CreateObject('scripting.dictionary')

10.    '将数据装入数组Arr

11.    Arr = Range('A3:A' & m)

12.    For i = 3 To UBound(Arr, 1)

13.        '将数据转换成字符串类型

14.        Str = Arr(i, 1)

15.        '如果字典中不存在Str，则

16.        If Not dic.exists(Str) Then

17.            '将Str作为关键字装入字典

18.            dic(Str) = ''

19.        End If

20.    Next

21.    '清空C列内容

22.    [C:C].ClearContents

23.    '以C3单元格为起始，调整数据写入区域，写入区域行数为dic.Count数目

24.    '将字典关键字转置后写入区域

25.    Range('C3').Resize(dic.Count, 1).Value = Application.Transpose(dic.keys)

26.    '清空字典

27.    Set dic = Nothing

28. End Sub

STEP 03

◆右键单击“按下有惊喜”按钮，弹出“指定宏”对话框

◆选择代码的宏名，确定；选中任一单元格，取消按钮选中状态

◆点击按钮即可一键提取不重复项