字典快速提取不重复项

　　本文转载自公众号：涂涂说Excel，作者：涂大荣。本文著作权归原创作者所有，本人收藏此文仅作为学习之用，不作其他目的，如有侵权请联系我删除。
　　大家好！我是涂涂
　　「Excel VBA」的字典用法--快速提取不重复项。
　　今天的内容
　　一个简单例子，需要将＂Sheet1＂工作表当中A列不重复的职位提取出来，结果填入C列淡粉色区域中。处理这类问题的方法有很多，比如删除重复项，高级筛选不重复项，Power Query，VBA等方法。
　　条条大路通罗马，今天涂涂分享使用VBA的字典来处理这类问题。
　　关联链接：
　　提取不重复项，这方法你用过吗？
　　去重复项效果动图
　　操作步骤
　　STEP 01
　　先将xlsx后缀的文件，另存为xlsm后缀的文件（xls后缀的不需要），否则工作簿关闭后代码就消失了。
　　◆打开xlsx后缀的文件，【开始】【另存为】
　　◆保存类型选择＂Excel启用宏的工作簿＂
　　STEP 02
　　◆按【Alt F11】打开VBE编辑界面
　　◆左侧选中该工作簿（看名称），右键【插入】【模块】
　　◆双击模块，在代码编辑窗口写入代码，关闭VBE界面
　　代码
　　Sub 去重复项()
　　Dim i As Long, m As Long, k As Long
　　Dim Str As String
　　Dim dic As Object
　　Dim Arr
　　＂A列非空行数，赋值给m
　　m = Worksheets(＂Sheet1＂).Cells(Rows.Count, 1).End(xlUp).Row
　　＂字典
　　Set dic = CreateObject(＂scripting.dictionary＂)
　　＂将数据装入数组Arr
　　Arr = Range(＂A3:A＂ & m)
　　For i = 3 To UBound(Arr, 1)
　　＂将数据转换成字符串类型
　　Str = Arr(i, 1)
　　＂如果字典中不存在Str，则
　　If Not dic.exists(Str) Then
　　＂将Str作为关键字装入字典
　　dic(Str) = ＂＂
　　End If
　　Next
　　＂清空C列内容
　　[C:C].ClearContents
　　＂以C3单元格为起始，调整数据写入区域，写入区域行数为dic.Count数目
　　＂将字典关键字转置后写入区域
　　Range(＂C3＂).Resize(dic.Count, 1).Value = Application.Transpose(dic.keys)
　　＂清空字典
　　Set dic = Nothing
　　End Sub
　　STEP 03
　　◆右键单击＂按下有惊喜＂按钮，弹出＂指定宏＂对话框
　　◆选择代码的宏名，确定；选中任一单元格，取消按钮选中状态
　　◆点击按钮即可一键提取不重复项