一列中如果有重复数据，使用代码直观找出来，效果如下图：

 实现的代码是：

Sub 数据查重()
Dim Rng, rng5 As Range
Set Rng = Application.InputBox("请选择你要查重的数据区域", , , , , , , 8)
 Dim dic As New Dictionary
 Dim s1, s2 As String
 s1 = "第"
          
 For i = 1 To Rng.Cells.Count '从第一个身份证号循环到最后一个
     rng4 = Rng.Cells(i)
     s2 = rng4
     If dic.Exists(s2) = False Then '如果字典中不存在这个身份证号才比对，如果已存在认为已经查找过了
        j = Application.WorksheetFunction.CountIf(Rng, rng4) '统计重复的次数
        Set rng5 = Rng.Cells(1) '先从第1行开始查找
        m = 1
        If j > 1 Then '大于1表示有重复
          Do '有几次重复就循环几次，超过次数就跳出循环
                            
             irow = Rng.Find(rng4, rng5, lookat:=xlWhole).Row '查找重复的行号
             Set rng5 = Rng.Cells(irow) '下一次开始查找的单元格
             m = m + 1 '记录查找了几次了
             s1 = s1 & irow & "行、" '拼接行号
          Loop While m < j + 1
        End If
          dic.Add s2, "j"'找过的加入字典不再查找
                  
    End If
                
    If Len(s1) > 1 Then '有重复的才显示
         Dim s3 As String 
         s3 = Mid(s1, 1, Len(s1) - 1)'去最后的顿号
        tt= sheets(1).[b20000].End(Xlup).row +1
        sheets(1).Range("b" & tt)=s3'向B列写入重复数据
        
     End If    
     s1 = "第"'初始化s1

 Next
End Sub