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

chxw68

参与一下。

gwjkkkkk

同心/ty 发表于 2023-4-19 20:34
老师，你的代码完善了着色处理，很新颖。但我贴中是把表头下移5行，并以行号作标注，不是用A列序号标注。 ...

按照8楼思路简单改一下。。。

同心/ty

你地铁图 发表于 2023-4-19 21:04
互相学习。。。

老师，你的代码不受增设表头行的影响，但有一点不足之处是当身份证在第1和2行时，比对出问题了，图中那个817和1747行根本没有数据，但提示与其重复。是不是代码还要完善、

同心/ty

chxw68 发表于 2023-4-19 21:25
参与一下。

老师，谢谢你！测试了一下，如果身份证中列中有空行，你也相比对，并提示一重复标注，这样会加大了审核整改时间，应该为空时不作比较才好。谢谢老师。

你地铁图

同心/ty 发表于 2023-4-19 22:00
老师，你的代码不受增设表头行的影响，但有一点不足之处是当身份证在第1和2行时，比对出问题了，图中那个 ...

不能确定你前五行的数据格式，
你前五行的主要作用是什么

chxw68

翛改好了。

同心/ty

你地铁图 发表于 2023-4-20 07:43
不能确定你前五行的数据格式，
你前五行的主要作用是什么

没有数据，只是表头。因为我看到你代码能脱离表头行数限制，特别好，能广泛应用。所以我就突发其想为何第1行与第2行显示结果不同？现在你的代码已经是最好的了。谢谢老师。

你地铁图

同心/ty 发表于 2023-4-20 10:32
没有数据，只是表头。因为我看到你代码能脱离表头行数限制，特别好，能广泛应用。所以我就突发其想为何第 ...

只要身分正那一列不是18个字符就行

lushang2018

1. Sub 测试()
   
2.     Dim i%, j%, s, brr
   
3.     Dim dic As Object, key, keys, items
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     Sheet1.Activate
   
6.     For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
   
7.         key = Cells(i, 5)
   
8.         dic(key) = dic(key) & "," & i
   
9.     Next
   
10.     For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
    
11.         key = Cells(i, 5)
    
12.         brr = Split(dic(key), ",")
    
13.         s = ""
    
14.         For j = 1 To UBound(brr)
    
15.             If brr(j) <> i Then
    
16.                 s = s & "," & brr(j)
    
17.                 Cells(i, 8) = "与第" & Mid(s, 2) & "行重复"
    
18.             End If
    
19.         Next
    
20.     Next
    
21. End Sub

复制代码

lushang2018