如果说身份证真有重复,大概率是录入错了,可以尝试在辅助列用countif公式,或者用VBA来处理有两种。一是只是弹出窗口提示对应的坐标:Sub FindDuplicatesAndDisplayInfo()
Dim rngA As Range
Dim rngB As Range
Dim dict As Object
Dim cellA As Range
Dim cellB As Range
Dim rowID As Long
Dim duplicatesFound As Boolean
Dim duplicatesInfo As String
Set rngA = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rngB = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set dict = CreateObject("Scripting.Dictionary")
For Each cellA In rngA
If Not dict.Exists(cellA.Value) Then
dict.Add cellA.Value, cellA.Row
Else
rowID = dict(cellA.Value)
duplicatesInfo = duplicatesInfo & "重复数据的坐标:" & cellA.Row & ", " & cellA.Column & ", 对应B列信息:" & rngB(rowID, 1).Value & vbNewLine
duplicatesInfo = duplicatesInfo & "重复数据的坐标:" & cellA.Row & ", " & cellA.Column & ", 对应B列信息:" & rngB(cellA.Row, 1).Value & vbNewLine
duplicatesFound = True
End If
Next cellA
If duplicatesFound Then
MsgBox "所有重复数据的坐标和对应B列信息:" & vbNewLine & duplicatesInfo
Else
MsgBox "没有找到重复数据。"
End If
Set rngA = Nothing
Set rngB = Nothing
Set dict = Nothing
End Sub
第二中是在新的列中填充所重复的数据坐标以及姓名所在列的文本信息:
Sub FindDuplicatesAndDisplayInfo()
Dim rngA As Range
Dim rngB As Range
Dim dict As Object
Dim cellA As Range
Dim cellB As Range
Dim rowID As Long
Dim duplicatesFound As Boolean
Dim duplicatesInfo As String
Dim lastRowD As Long
Set rngA = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row)
Set rngB = Range("B1:B" & Cells(Rows.Count, "B").End(xlUp).Row)
Set dict = CreateObject("Scripting.Dictionary")
For Each cellA In rngA
If Not dict.Exists(cellA.Value) Then
dict.Add cellA.Value, cellA.Row
Else
rowID = dict(cellA.Value)
duplicatesInfo = duplicatesInfo & "重复数据的行列坐标:" & cellA.Row & ", " & cellA.Column & ", 对应B列信息:" & rngB(rowID, 1).Value & vbNewLine
duplicatesInfo = duplicatesInfo & "重复数据的行列坐标:" & cellA.Row & ", " & cellA.Column & ", 对应B列信息:" & rngB(cellA.Row, 1).Value & vbNewLine
Range("D" & cellA.Row) = duplicatesInfo
duplicatesFound = True
End If
duplicatesInfo = ""
Next cellA
If duplicatesFound Then
MsgBox "所有重复数据的行列坐标和对应B列信息已填充到D列。"
Else
MsgBox "没有找到重复数据。"
End If
Set rngA = Nothing
Set rngB = Nothing
Set dict = Nothing
End Sub
效果分别如下:
如果你的表格结构无法更改可以使用的一个VBA(更改为你自己数据所在列就可以了),如果结构可以更改,那么还是推荐用上面的公式。