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

smiletwo

nmcfbgttyl 发表于 2017-10-16 23:13
老师，您好，感谢您在http://club.excelhome.net/thread-1258892-1-1.html帮我解决查重复问题，现在想在 ...

不用字典的
Sub aa()
Dim num As Integer, sht1 As Worksheet, sht2 As Worksheet
Set sht1 = Sheets("表A")
Set sht2 = Sheets("表B")
num = 2
Call tabl(2, sht1, sht2)
num = 1
Set sht1 = Sheets("表B")
Set sht2 = Sheets("表A")
Call tabl(1, sht1, sht2)
End Sub
Sub tabl(num%, sht1 As Worksheet, sht2 As Worksheet)
  Dim i, j, sam
  Dim arr, brr
  arr = sht1.Range("A1").CurrentRegion
  brr = sht2.Range("A1").CurrentRegion
  sht1.Activate
  sht1.Range(Cells(2, 8), Cells(UBound(arr), 8)).Clear
  For i = 2 To UBound(arr)
     sam = ""
     For j = 2 To UBound(brr)
        If arr(i, 5) = arr(j, 5) Then
           If sam <> "" Then
             sam = sam & "," & j
           Else
             sam = sam & j
           End If
        End If
      Next
      If sam <> "" Then
        arr(i, 8) = "与表" & num & "第" & sam & "行重复"
      End If
  Next
  sht1.Range("A1").CurrentRegion = arr
  sht1.Range(Cells(2, 8), Cells(UBound(arr), 8)).Font.Color = vbRed
End Sub

同心/ty

看见星光 发表于 2016-2-15 09:21

老师，如果身份证列出现身份证号为空的，不作比较，该如何完善代码？

同心/ty

看见星光 发表于 2016-2-15 09:21

老师，如果此表表头向下移动6行，代码如何修改？请帮我。谢谢！