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

kszcs · 发表于 2016-11-20 14:33

高手云集，谢谢

lzqmsy · 发表于 2016-11-20 14:58

再次一并谢谢楼上各位老师,我慢慢消化理解

lzqmsy · 发表于 2016-11-20 15:41

huang1314wei 发表于 2016-11-20 08:10

谢谢您的回复,我要的是只显示重复的部分,出现一次的不要显示,不知您的代码稍加修改能否实现,有时间再帮看看,谢谢!!!

lzqmsy · 发表于 2016-11-20 15:47

jsgj2023 发表于 2016-11-20 08:52

谢谢您的回复,我要的是只显示重复的部分,出现一次的不要显示,不知您的代码稍加修改能否实现,有时间再帮看看,谢谢!!!

lzqmsy · 发表于 2016-11-20 15:59

Yaong_3 发表于 2016-11-20 08:53
思路清晰，代码简练，不愧大侠风范。
在此小补一个 IF 判断，屏蔽一下不重复的记录。献丑了。

谢谢您的回复,您的回复正是我想要的,但由于数据量大,用了 If Application.WorksheetFunction.CountIf(Range("A:A"), arr(i, 1)) > 1 Then 这个函数后速度就很慢了,数据达到1400行时,需要3秒,不知道有没有能快些的,再次谢谢!!!

ykqrs · 发表于 2016-11-20 16:18

可以写的再啰嗦一点吗？

Sub qq()
Dim d, i%, arr, k, t, aa, brr()
Set d = CreateObject("scripting.dictionary")
arr = Range("A1").CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) & "," & i
Next
For Each aa In d.keys
If UBound(Split(d(aa), ",")) = 1 Then d.Remove (aa)
Next
k = d.keys: t = d.items
ReDim brr(1 To d.Count, 1 To 3)
For i = 1 To d.Count
brr(i, 1) = k(i - 1)
brr(i, 2) = UBound(Split(t(i - 1), ","))
brr(i, 3) = Mid(t(i - 1), 2)
Next
[I1].CurrentRegion.Offset(4).Clear
[I5].Resize(d.Count, 3) = brr
End Sub

复制代码

jsgj2023 · 发表于 2016-11-20 16:22

老师，请测试。

ykqrs · 发表于 2016-11-20 16:25

VBA找重复值及所在行号的求助.zip (11.49 KB, 下载次数: 51)

jsgj2023 · 发表于 2016-11-20 16:43

ykqrs 发表于 2016-11-20 16:18
可以写的再啰嗦一点吗？

呵呵，老师批评的是，因初学，很多地方转不过弯来。路很长，向您们学习。

ykqrs · 发表于 2016-11-20 17:03

jsgj2023 发表于 2016-11-20 16:43
呵呵，老师批评的是，因初学，很多地方转不过弯来。路很长，向您们学习。

没有这个意思，我是说我写的啰嗦，呵呵，VBA也是近一两年才慢慢接触

		自动登录	找回密码
密码			免费注册

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

评分

评分