excel身份证验证（附带防止粘贴导致校验失效的函数）

一、检验函数

=IF(LEN(A1)=18,MID("10X98765432",MOD(SUMPRODUCT(MID(A1,ROW(INDIRECT("1:17")),1)*2^(18-ROW(INDIRECT("1:17")))),11)+1,1)=RIGHT(A1))----18位校验

二、防止粘贴导致校验失效的函数

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim rng As Range
   Dim c As String
    For Each rng In Target
    If Not rng.Validation.Value Then
        Application.Undo
        Dim msg As String
        msg = "粘贴的数据不符合校验规则：位置在第" & rng.Row & "行，第" & getColumnName(rng.column) & "列，请仔细检查"
        MsgBox prompt:=msg, Title:="输入提示"
    Exit For
    End If
Next
End Sub

Private Function getColumnName(column As Integer) As String
    Dim alphabet(26) As String
    alphabet(0) = "A"
    alphabet(1) = "B"
    alphabet(2) = "C"
    alphabet(3) = "D"
    alphabet(4) = "E"
    alphabet(5) = "F"
    alphabet(6) = "G"
    alphabet(7) = "H"
    alphabet(8) = "I"
    alphabet(9) = "J"
    alphabet(10) = "K"
    alphabet(11) = "L"
    alphabet(12) = "M"
    alphabet(13) = "N"
    alphabet(14) = "O"
    alphabet(15) = "P"
    alphabet(16) = "Q"
    alphabet(17) = "R"
    alphabet(18) = "S"
    alphabet(19) = "T"
    alphabet(20) = "U"
    alphabet(21) = "V"
    alphabet(22) = "W"
    alphabet(23) = "X"
    alphabet(24) = "Y"
    alphabet(25) = "Z"

    If (column < 27) Then
        getColumnName = alphabet(column - 1)
    Else
        Dim i, j As Integer
        i = column \ 26
        j = column Mod 26
        If (i < 26) Then
            getColumnName = alphabet(i - 1) & alphabet(j - 1)
        Else
            getColumnName = column
        End If

    End If

End Function