字典快速提取不重复项

　　本文转载自公众号：涂涂说Excel，作者：涂大荣。本文著作权归原创作者所有，本人收藏此文仅作为学习之用，不作其他目的，如有侵权请联系我删除。
　　大家好！我是涂涂
　　ExcelVBA的字典用法快速提取不重复项。
　　今天的内容
　　一个简单例子，需要将Sheet1工作表当中A列不重复的职位提取出来，结果填入C列淡粉色区域中。处理这类问题的方法有很多，比如删除重复项，高级筛选不重复项，PowerQuery，VBA等方法。
　　条条大路通罗马，今天涂涂分享使用VBA的字典来处理这类问题。
　　关联链接：
　　提取不重复项，这方法你用过吗？
　　去重复项效果动图
　　操作步骤
　　STEP01
　　先将xlsx后缀的文件，另存为xlsm后缀的文件（xls后缀的不需要），否则工作簿关闭后代码就消失了。
　　打开xlsx后缀的文件，【开始】【另存为】
　　保存类型选择Excel启用宏的工作簿
　　STEP02
　　按【AltF11】打开VBE编辑界面
　　左侧选中该工作簿（看名称），右键【插入】【模块】
　　双击模块，在代码编辑窗口写入代码，关闭VBE界面
　　代码
　　Sub去重复项（）
　　DimiAsLong，mAsLong，kAsLong
　　DimStrAsString
　　DimdicAsObject
　　DimArr
　　A列非空行数，赋值给m
　　mWorksheets（Sheet1）。Cells（Rows。Count，1）。End（xlUp）。Row
　　字典
　　SetdicCreateObject（scripting。dictionary）
　　将数据装入数组Arr
　　ArrRange（A3：Aamp；amp；m）
　　Fori3ToUBound（Arr，1）
　　将数据转换成字符串类型
　　StrArr（i，1）
　　如果字典中不存在Str，则
　　IfNotdic。exists（Str）Then
　　将Str作为关键字装入字典
　　dic（Str）
　　EndIf
　　Next
　　清空C列内容
　　〔C：C〕。ClearContents
　　以C3单元格为起始，调整数据写入区域，写入区域行数为dic。Count数目
　　将字典关键字转置后写入区域
　　Range（C3）。Resize（dic。Count，1）。ValueApplication。Transpose（dic。keys）
　　清空字典
　　SetdicNothing
　　EndSub
　　STEP03
　　右键单击按下有惊喜按钮，弹出指定宏对话框
　　选择代码的宏名，确定；选中任一单元格，取消按钮选中状态
　　点击按钮即可一键提取不重复项