ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > 我的酷贴 > Excel VBA > 自定义工具--筛选多列不重复值工具

自定义工具--筛选多列不重复值工具

作者:绿色风 分类: 时间:2022-08-18 浏览:65
楼主
hlxz
筛选多列不重复值工具


 

可以 本工作表 上显示结果
也可以另外一个工作表上显示结果

今天是我的生日

为此源码和大家分享
因为 是vb 写 的 dll
所以我就 不改成vba 了

  1. Private Sub gj_筛选多列不重复工具()
  2. On Error Resume Next
  3. Dim EB, BTrange As Range, XZrange As Range
  4. Dim 表格ONE, 表格TWO
  5. Set EB = GetObject(, "Excel.application")
  6. EB.DisplayAlerts = False
  7. Dim Down
  8.   Down = MsgBox("你是执行判断多列筛选不重复操作!" & vbCrLf & "   是否执行?", vbQuestion + vbYesNo, "系统提示")
  9. If Down = vbNo Then
  10.     Exit Sub
  11. End If
  12. 'BTDZ标题地址
  13. 10000: Set BTrange = EB.InputBox(prompt:="请在工作表上选择多列筛选不重复的区域", Title:="系统信息", Type:=8)
  14.   If BTrange.Rows.Count < 1 Then
  15.   MsgBox "请重新选择工资条标题的区域", 0, "系统提示"
  16.   GoTo 10000
  17.   End If
  18.   表格ONE = BTrange.Worksheet.Name
  19. 20000: Set XZrange = EB.InputBox(prompt:="请在工作表上选择筛选结果放置区域", Title:="系统信息", Type:=8)
  20.   If XZrange.Rows.Count < 1 Then
  21.   MsgBox "请重新选择工资条标题的区域", 0, "系统提示"
  22.   GoTo 20000
  23.   End If
  24.   表格TWO = XZrange.Worksheet.Name
  25. EB.Sheets(表格ONE).Range(BTrange.Address).Select
  26. EB.Sheets(表格ONE).Range(BTrange.Address).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=EB.Sheets(表格TWO).Range(XZrange.Address), Unique:=True
  27.   Set BTrange = Nothing
  28.   Set XZrange = Nothing
  29.   Set EB = Nothing
  30.   MsgBox "筛选多列不重复完成", 0 + 48, "小爪提醒你"
  31. EB.Sheets(表格TWO).Select
  32. EB.DisplayAlerts =true
  33. End Sub

2楼
bobij
欢乐小爪好熟悉的QQ,今天是你的生日,第一个在这里祝你happy  birthday.也感谢你的分享!嘿嘿!
3楼
amyee
虽然不认识,生日是一定要说一句生日快乐的。生日快乐,天天开心。
4楼
sy053
再次谢谢小爪,谢谢你的帮助。

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap