设为首页收藏本站
开启辅助访问

Excel精英培训网

 找回密码
 注册
Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 同列重复数据提示
数据透视表40+个常用小技巧，让你一次学会！
12下一页
返回列表 发新帖
查看: 3915|回复: 14

[已解决]同列重复数据提示

[复制链接]
发表于 2016-11-12 17:57 | 显示全部楼层 |阅读模式
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
附件中的代码基本上实现了要求，但还有点不足，请帮忙改进一下（在原代码基础上改进）：
1、msgbox显示的内容一次性显示在一起，提示中能够显示出什么重复了多少次？2、如果要将MsgBox显示的结果放到F列中，怎么实现？
真心请教。如果方便请赐教。谢谢！



最佳答案
月排行榜 / 总排行榜
su45
2016-11-14 11:12
本帖最后由 su45 于 2016-11-14 11:24 编辑

哦，我理解错了，那就用3楼的代码就是了，或者 ：

  1. Sub test()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Application.ScreenUpdating = False
  4.     Arr = [c2].CurrentRegion
  5.     [c2].CurrentRegion.ClearFormats
  6.     For j = 1 To UBound(Arr)
  7.         If d.exists(Arr(j, 1)) Then
  8.             Set d(Arr(j, 1)) = Union(Cells(j + 1, 3), d(Arr(j, 1)))
  9.         Else
  10.             Set d(Arr(j, 1)) = Cells(j + 1, 3)
  11.         End If
  12.     Next
  13.     For Each rng In d.items
  14.         If rng.Count > 1 Then
  15.             c = rng.Text
  16.             rng.Interior.Color = 255
  17.             a = a + 1
  18.             Cells(a, "F") = c & "重复了" & rng.Count & "次，单元格是：（" & rng.Address(0, 0) & "）"
  19.             p = p & c & "重复了" & rng.Count & "次，单元格是：（" & rng.Address(0, 0) & "）" & Chr(10)
  20. '            MsgBox "重复了" & rng.Count & "次，单元格是：（" & rng.Address(0, 0) & "）"
  21.         End If
  22.     Next
  23.     If p <> "" Then MsgBox p
  24.     Application.ScreenUpdating = True
  25. End Sub
复制代码


同列重复数据提示.rar

10.28 KB, 下载次数: 16
excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上
dsmch
发表于 2016-11-13 10:48 | 显示全部楼层
工作中常用的Excel函数公式，全印在一张超大鼠标垫上
  1. Sub test()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Application.ScreenUpdating = False
  4.     Arr = [c2].CurrentRegion
  5.     [c:c].Interior.ColorIndex = xlNone
  6.     For j = 1 To UBound(Arr)
  7.         d(Arr(j, 1)) = d(Arr(j, 1)) & "," & Cells(j + 1, 3).Address(0, 0)
  8.     Next
  9.     For Each a In d.keys
  10.         zf = Mid(d(a), 2)
  11.         x = Split(zf, ",")
  12.         If UBound(x) > 0 Then
  13.             n = n + 1
  14.             Range(zf).Interior.Color = 255
  15.             Cells(n, "f") = a & "重复了" & UBound(x) + 1 & "次，单元格是：" & zf
  16.         End If
  17.     Next
  18.     Application.ScreenUpdating = True
  19. End Sub
复制代码

评分

参与人数 1 +3 收起 理由
cunfu2010 + 3 很给力

查看全部评分

回复

使用道具 举报

su45
发表于 2016-11-13 15:08 | 显示全部楼层
工作中最常用的Excel函数公式，全印在一张鼠标垫上
楼上大侠给你解决了第2个问题，我就添油加醋，补下第一个问题：

  1. Sub test()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Application.ScreenUpdating = False
  4.     Arr = [c2].CurrentRegion
  5.     [c:c].Interior.ColorIndex = xlNone
  6.     For j = 1 To UBound(Arr)
  7.         d(Arr(j, 1)) = d(Arr(j, 1)) & "," & Cells(j + 1, 3).Address(0, 0)
  8.     Next
  9.     For Each a In d.keys
  10.         zf = Mid(d(a), 2)
  11.         x = Split(zf, ",")
  12.         If UBound(x) > 0 Then
  13.             n = n + 1
  14.             Range(zf).Interior.Color = 255
  15.             Cells(n, "f") = a & "重复了" & UBound(x) + 1 & "次，单元格是：" & zf
  16.             p = p & a & "重复了" & UBound(x) + 1 & "次，单元格是：" & zf & Chr(10)
  17.         End If
  18.     Next
  19.     If p <> "" Then MsgBox p
  20.     Application.ScreenUpdating = True
  21. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2016-11-13 20:06 | 显示全部楼层
dsmch 发表于 2016-11-13 10:48

谢谢！我先学习学习，有问题再麻烦。
回复

使用道具 举报

 楼主| 发表于 2016-11-13 20:07 | 显示全部楼层
su45 发表于 2016-11-13 15:08
楼上大侠给你解决了第2个问题，我就添油加醋，补下第一个问题：

谢谢关注！！！
回复

使用道具 举报

 楼主| 发表于 2016-11-13 20:09 | 显示全部楼层
dsmch 发表于 2016-11-13 10:48

如果还是用For Each rng In d.items能实现结果吗
回复

使用道具 举报

 楼主| 发表于 2016-11-13 20:10 | 显示全部楼层
su45 发表于 2016-11-13 15:08
楼上大侠给你解决了第2个问题，我就添油加醋，补下第一个问题：

如果还是用For Each rng In d.items能实现结果吗
回复

使用道具 举报

su45
发表于 2016-11-13 23:21 | 显示全部楼层
为什么非要用For Each rng In d.items ？
这样行了吧？

  1. Sub test()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     Application.ScreenUpdating = False
  4.     Arr = [c2].CurrentRegion
  5.     [c2].CurrentRegion.ClearFormats
  6.     For j = 1 To UBound(Arr)
  7.         If d.exists(Arr(j, 1)) Then
  8.             Set d(Arr(j, 1)) = Union(Cells(j + 1, 3), d(Arr(j, 1)))
  9.         Else
  10.             Set d(Arr(j, 1)) = Cells(j + 1, 3)
  11.         End If
  12.     Next
  13.     For Each rng In d.items
  14.         If rng.Count > 1 Then
  15.             rng.Interior.Color = 255
  16.             a = a + 1
  17.             Cells(a, "F") = "重复了" & rng.Count & "次，单元格是：（" & rng.Address(0, 0) & "）"
  18.             p = p & "重复了" & rng.Count & "次，单元格是：（" & rng.Address(0, 0) & "）" & Chr(10)
  19. '            MsgBox "重复了" & rng.Count & "次，单元格是：（" & rng.Address(0, 0) & "）"
  20.         End If
  21.     Next
  22.     If p <> "" Then MsgBox p
  23.     Application.ScreenUpdating = True
  24. End Sub
复制代码
回复

使用道具 举报

 楼主| 发表于 2016-11-14 08:45 | 显示全部楼层
su45 发表于 2016-11-13 23:21
为什么非要用For Each rng In d.items ？
这样行了吧？

谢谢，就是想学习一下，拓宽点思路
回复

使用道具 举报

 楼主| 发表于 2016-11-14 09:10 | 显示全部楼层
su45 发表于 2016-11-13 23:21
为什么非要用For Each rng In d.items ？
这样行了吧？

运行了一下代码，谁重复怎么没有了？能给再看看吗
回复

使用道具 举报

下一页 »
12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-6-6 08:55 , Processed in 0.371900 second(s), 15 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表