源：http://club.excelhome.net/thread-407365-1-1.html

**************  代码开始 *************

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngA As Range
    Dim cntA As Integer
    For Each rngA In Target
        If rngA = "" Then
        Else
            cntA = Application.WorksheetFunction.CountIf(ActiveSheet.Range("A:A"), rngA)'查找的列范围
      If cntA > 1 Then
                MsgBox "重复数据[" & rngA & "]", vbCritical, "错误"
                 rngA=""
            End If
        End If
    Next
End Sub 

**************  代码结束 *************

以上VBA过程，对新身份证号码无效！

回6楼的，刚发现，您的VBA，对新身份证号无效，不重复的号码也报重复，关键是您用的工作表函数COUNTIF() 对超过15位的数字和文本数字，均认为是重复的。
望6楼的高手再作修改，谢谢！！！

用Countif("A:A",A1&"*")=1设置数据有效性就可以了。