18位身份证号码校验，每当某列数据有更新就自动执行相应的vab代码

骑马上树

首先感谢大神

插入一个模块：
Function CheckForPersonalLicence(ByVal str As String) As Integer
    CheckForPersonalLicence = 0
    If str = "" Then
       CheckForPersonalLicence = 0
       Exit Function
    End If
    If Len(str) <> 18 Then
        CheckForPersonalLicence = 1
        Exit Function
    End If
    '校验前17位是否为数字/检验第18位校验码是否正确'
    arr = Array("7", "9", "10", "5", "8", "4", "2", "1", "6", "3", "7", "9", "10", "5", "8", "4", "2")
    brr = Array("1", "0", "x", "9", "8", "7", "6", "5", "4", "3", "2")
    For h = 1 To 17
        j = Mid(str, h, 1)
        If IsNumeric(j) = False Then
            CheckForPersonalLicence = 1
            Exit Function
        End If
        s = s + j * arr(h - 1)
    Next
    k = s Mod 11
    If Mid(str, 18, 1) <> brr(k) Then
        CheckForPersonalLicence = 2
        Exit Function
    End If
End Function

在sheet2用Worksheet_Change(ByVal  Target  As  Range )
Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Columns.Count > 1 Or .Column <> 1 Then Exit Sub
        Dim TargetR As Range
        For Each TargetR In .Cells
            Select Case CheckForPersonalLicence(TargetR.Text)
            Case 1
                TargetR.Interior.Color = vbRed
            Case 2
                TargetR.EntireRow.Interior.Color = vbGreen
            Case 0
                TargetR.EntireRow.Interior.ColorIndex = xlNone
            End Select
        Next
    End With
End Sub

骑马上树

帖子保存了怎么编辑啊