用VBA找出某列中身份证号重复记录并标出

nmcfbgttyl

各位老师，新年好！！

有一工作表，数据N条（超千甚至超万），列字段如下：

序号

姓名

性别

住址

身份证号

业绩

备注

是否重复

怎样通过　身份证号　一列，找出并标出重复记录，并标出与哪一行重复，模拟结果如图：



附件： 求助-用VBA找出身份证号重复人员.rar (3.53 KB, 下载次数: 0)

请各位老师帮忙，用VBA完成，谢谢！

jnsxmt

求助-用VBA找出身份证号重复人员 ...

dfdfsfds

求助-用VBA找出身份证号重复人员.zip (10.01 KB, 下载次数: 203)

2016-2-15 09:12 上传

点击文件名下载附件

看见星光

1. Sub dd()
   
2. Dim d As Object, arr, brr, i&, j&, k
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Range("e1:e" & [a1].CurrentRegion.Rows.Count)
   
5. For i = 2 To UBound(arr)
   
6.     d(arr(i, 1)) = d(arr(i, 1)) & "," & i
   
7. Next
   
8. ReDim brr(2 To UBound(arr), 1 To 1)
   
9. For i = 2 To UBound(arr)
   
10.     k = Mid(Replace(d(arr(i, 1)), "," & i, ""), 2)
    
11.     If Len(k) Then brr(i, 1) = "与第" & k & "行重复"
    
12. Next
    
13. [h2].Resize(UBound(arr) - 1, 1) = brr
    
14. Set d = Nothing
    
15. End Sub
    

复制代码

看见星光

refor to 人员.zip (15.48 KB, 下载次数: 424)

2016-2-15 09:23 上传

点击文件名下载附件

doul123

1. Private Sub CommandButton1_Click()
   
2.     Dim Rng As Range
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.    
   
5.     '向字典中添加数据
   
6.     For i = 2 To Cells(Rows.Count, 5).End(3).Row
   
7.         d.Add Cells(i, 1), Cells(i, 5)
   
8.     Next
   
9.    
   
10.     A = d.keys
    
11.     B = d.Items
    
12.    
    
13.     '在字典中查找数据
    
14.     For Each Rng In Range("E2:E" & Cells(Rows.Count, 5).End(3).Row)
    
15.         For i = 0 To d.Count - 1
    
16.             If Rng.Value = B(i) And Rng.Row - 1 <> A(i) Then
    
17.                 Rng.Offset(0, 3).Value = "与第" & A(i) + 1 & "行重复"
    
18.             End If
    
19.         Next
    
20.     Next
    
21. End Sub
    

复制代码

nmcfbgttyl

首先感谢各位老师的帮忙！谢谢！
对以上四位老师的代码分别做了5000条数据测试，都能找出重复身份证号行，但有明显区别：
二楼、三楼、六楼三位老师的代码运行时间长，约80秒，如果有多次重复（一个身份证号多次出现，多于两次）标记时，只标记最后找到的行号，


四楼老师的代码是最理想的，用时很短，秒杀！，多次重复（一个身份证号多次出现，多于两次）标记时，都能标记出。

谢谢各位老师！

nmcfbgttyl

看见星光 发表于 2016-2-15 09:23
refor to

您好，您帮我写的  用VBA找出某列中身份证号重复记录并标出  代码，是最完美的，谢谢您，
能否再帮我看一下：http://club.excelhome.net/forum. ... p;extra=#pid8561885
谢谢！

Yedajun

看见星光 发表于 2016-2-15 09:23
refor to

不要第一行，代码修改如下，若第1行、与第8行、第13行重复，为何第一行统计不对？求大师解一下！
Sub dd()
Dim d As Object, arr, brr, i&, j&, k
Set d = CreateObject("scripting.dictionary")
arr = Range("e1:e" & [a1].CurrentRegion.Rows.Count)
For i = 1 To UBound(arr)
    d(arr(i, 1)) = d(arr(i, 1)) & "," & i
Next
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    k = Mid(Replace(d(arr(i, 1)), "," & i, ""), 2)
    If Len(k) Then brr(i, 1) = "与第" & k & "行重复"
Next
[h1].Resize(UBound(arr), 1) = brr
Set d = Nothing
End Sub

sjh701120

看见星光 发表于 2016-2-15 09:23
refor to

老师，你好，试了下你的代码，非常好用，谢谢！现在有个问题，如果查询列中有空的，后面的数据不能查重，可以解决吗？