求助代码,取重复值并显示所在行号

lzqmsy

wzsy2_mrf 发表于 2016-11-20 21:01

谢谢,代码速度很快,只是返回的行号还有一点问题,麻烦再斟酌一下

wzsy2_mrf

lzqmsy 发表于 2016-11-20 21:20
谢谢,代码速度很快,只是返回的行号还有一点问题,麻烦再斟酌一下

有何问题？
上海不就是出现了四次吗？
你的模拟是错误的

lsc900707

wzsy2_mrf 发表于 2016-11-20 21:26
有何问题？
上海不就是出现了四次吗？
你的模拟是错误的

你看多两次帖子就知道什么了>>>>>>>>

lzqmsy

wzsy2_mrf 发表于 2016-11-20 21:26
有何问题？
上海不就是出现了四次吗？
你的模拟是错误的

返回的行号连在一起了,组成了新的数字,位数多了后边的都变成0了,我刚才将那列单元格格式设置成文本就可以了,再次谢谢

wzsy2_mrf

要显示在旁边可用如下：

1. Sub 找重复值()
   
2.     Dim r%, i%, arr, mkey, mitems
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     r = Cells(Rows.Count, 1).End(xlUp).Row
   
5.     arr = Range("a1:c" & r)
   
6.     For i = 2 To UBound(arr)
   
7.         If Not d.Exists(arr(i, 1)) Then
   
8.             d(arr(i, 1)) = i
   
9.         Else
   
10.             d(arr(i, 1)) = d(arr(i, 1)) & "," & i
    
11.         End If
    
12.     Next
    
13.     For Each mkey In d.keys
    
14.         mitems = Split(d(mkey), ",")
    
15.         r = UBound(mitems): i = mitems(0)
    
16.         If r > 0 Then
    
17.             arr(i, 2) = r + 1: arr(i, 3) = d(mkey)
    
18.         End If
    
19.     Next
    
20.     Range("a1").Resize(60000, UBound(arr, 2)).Clear
    
21.     Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    
22.     Erase arr, mitems: Set d = Nothing
    
23. End Sub

复制代码

fxl447098457

我这里运行是可以的，我传个附件吧。结果数据是分放在单元格的。不是连接行号。
VBA找重复值及所在行号的求助.rar (10.53 KB, 下载次数: 42)

2016-11-20 21:56 上传

点击文件名下载附件

lzqmsy

fxl447098457 发表于 2016-11-20 21:57
我这里运行是可以的，我传个附件吧。结果数据是分放在单元格的。不是连接行号。

您的附件好用,速度很快,数据源1412行时,用时是0.0625秒,很好很好,再次谢谢!!!

lzqmsy

fxl447098457 发表于 2016-11-20 21:57
我这里运行是可以的，我传个附件吧。结果数据是分放在单元格的。不是连接行号。

新建一个表,用你的代码就好用,用在我原来的文件里就不好用,提示类型错误,我仔细检查一下,发现引用不一样

lzqmsy

wzsy2_mrf 发表于 2016-11-20 21:54
要显示在旁边可用如下：

好的,谢谢!!!

TJSCSA

好多大神，受教了，一个一个学习