身份证列查重

zjcctv2006

各位好！如果身份证号在A列从第四行开始，用代码如何查重，如有重复改变颜色。代码该怎样写谢谢！！！

liulang0808

https://club.excelhome.net/threa ... tml?_dsign=b73ad3d6
字典的案例，可以参考下

全党

Sub 去重()
Set dic = CreateObject("Scripting.Dictionary")
arr = Range("a1").CurrentRegion
For i = 4 To UBound(arr)
dic(arr(i, 1)) = dic(arr(i, 1)) + 1
h = dic.items
Next
For i = 4 To UBound(arr)
If dic(arr(i, 1)) > 1 Then
Cells(i, 1).Interior.Color = 255
End If
Next
End Sub

xunanming

用工作表函数countif.也可以用字典实现
Sub test1()
Dim area As Range, i

Set area = Range("a4:a" & Cells(Rows.Count, 1).End(3).Row)
For i = 1 To Cells(Rows.Count, 1).End(3).Row
        If Application.CountIf(area, Cells(i, 1)) > 1 Then
                Cells(i, 1).Interior.ColorIndex = 3
        End If
Next
End Sub

zjcctv2006

谢谢各位帮忙！

zjcctv2006

全党 发表于 2023-3-31 13:23
Sub 去重()
Set dic = CreateObject("Scripting.Dictionary")
arr = Range("a1").CurrentRegion

老师你好！我是这么写的为什么其中一行没有变色？
Sub ss()
Dim i&, j&, arr, d As Object
Set d = CreateObject("scripting.dictionary")
j = Sheet1.Range("a65536").End(xlUp).Row
arr = Sheet1.Range("a1:a" & j)
For i = 4 To j
   If Not d.exists(arr(i, 1)) Then
    d(arr(i, 1)) = ""
  Else
    'Stop
     Cells(i, 1).Interior.ColorIndex = 7
   End If
   Next
End Sub

mmwwdd

zjcctv2006 发表于 2023-4-3 08:48
老师你好！我是这么写的为什么其中一行没有变色？
Sub ss()
Dim i&, j&, arr, d As Object

有没有空格,选搜索替换掉空格