高清电影_高清电视剧_热门资讯_Excel学习_迅雷电影下载_网络资源

VBA代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Dim arr, i%
    If Target.Column = 2 Then
        Range("b:b").Interior.ColorIndex = xlNone
        arr = Range("b2").Resize([b65536].End(3).Row - 2, 1)
        If Len(Target) <> 15 And Len(Target) <> 18 And Target <> "" Then
            MsgBox "非有效身份证,请修改"
            Target.Select
            Target.Interior.ColorIndex = 40
        Else
            For i = 1 To UBound(arr)
                If Target.Row <> 3 Then
                    If Target.Value = arr(i, 1) Then
                        MsgBox "已重复，请修改"
                        Target.Select
                        Target.Interior.ColorIndex = 40
                        Exit For
                    End If
                End If
            Next i
        End If
    End If
End Sub