在EXCEL中VBA编程检验身份证号码有效性

Posted 紫郢剑侠

tags:

篇首语:本文由小常识网(cha138.com)小编为大家整理,主要介绍了在EXCEL中VBA编程检验身份证号码有效性相关的知识,希望对你有一定的参考价值。

*2022-12-05 改正代码中错别字,规范表述

*2022-11-30 1.增加了过程clearB()用来清除B1:Bx原有的出错说明,在过程examIdentityCard() 开头调用

                    2.修改了过程examIdentityCard(),如果身份证号码包含多余的字符则提示"包括多余字符;"

参加数据治理工作,使用库表转换功能把excel表格数据上传到平台上的数据库,在进行数据质量检测时,有许多身份证号码数据被检测为“非身份证号码”,但没有更具体的说明,比如是数据位数不对(应为15位或18位),出生日期不对(1986-02-30),或者是末位校验码不对……等等。

把这些包含被检测为“非身份证号码”的异常数据导出为Excel表格,再用VBA写代码来校验分析。

网上的关于检验身份证号码的代码很多,但基本不能拿来就用,还得结合自己的实际应用情况进行修改完善。

编写过程中的体会主要有两点:

一是对于18位身份证号码,末位的x可能被写成乘号×、全角大写x、全角小写x,而我们用的数据库系统数据质量检测只认大写半角X,写成乘号×、全角大写x、小写半角x都会被认为“非身份证号码”。这些都要进行预处理,将它们转换为大写半角X。预处理代码如下:

        v = Rng.text
        '检查是否包含×
        If InStr(v, "×") > 0 Then
            v = Replace(v, "×", "X", 1, -1)
            Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X;"
        End If
    
        '检查是否包含全角大写x
        If InStr(v, "X") > 0 Then
            v = Replace(v, "X", "X", 1, -1)
            Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X;"
        End If
    
        '检查是否包含全角小写x
        If InStr(v, "x") > 0 Then
            v = Replace(v, "x", "X", 1, -1)
            Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X;"
        End If

二是身份证号码可能包含非打印字符,不做处理的话,就会影响Len()返回值,进而影响到身份证位数的判断。而在实际处理中,发现VBA提供的Trim()、Application.WorksheetFunction.Clean()都清理不干净,网上的代码也不适合我的情况,于是自己DIY了一个:

Function DelUnprintChar(s) As String
    r = ""
    For iPosition = 1 To Len(s) Step 1
        c = Mid(s, iPosition, 1)
        If ((c >= "0") And (c <= "9")) Or ((c >= "a") And (c <= "z")) Or ((c >= "A") And (c <= "Z")) Then
            r = r & c
        End If
    Next
    DelUnprintChar = r
End Function

完整的代码如下(身份证号码数据在A1:Ax,数据错误显示在B1:Bx)。:


Function exam18(v) As String
    Dim cd1, r
    r = ""
    
    '下面检验出生日期是否正确
    cd1 = Mid(v, 7, 4) & "-" & Mid(v, 11, 2) & "-" & Mid(v, 13, 2)
    If Not IsDate(cd1) Then
        r = "出身日期" & cd1 & "无效;"
    Else
        r = examIdentityCardLastDigit(v)
    End If
        
    exam18 = r
End Function

Function exam15(v) As String
    '对15位身份证号码进行校验
    Dim a, r
    r = ""

    '是否全数字
    If Not IsNumeric(r) Then
       r = "15位身份证号码应全是数字;"
    Else
        '下面检验出生日期是否正确
        a = Mid(v, 7, 2) & "-" & Mid(v, 9, 2) & "-" & Mid(v, 11, 2)
        If Not IsDate(a) Then
            r = "出生日期" + a + "无效;"
        End If
    End If
    exam15 = r
End Function



Function examIdentityCardLastDigit(v) As String
    Dim i, arr1(), arr2(), r, s

    arr1 = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2) '系数
    arr2 = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2") '对应的结果
    
    r = ""
    t = Left(v, 17)
    If Not IsNumeric(t) Then
       r = "身份证号码前17位应是数字;"
    Else
        s = 0
        For i = 1 To 17
            t = Mid(v, i, 1) '取出每位数
            s = s + t * arr1(i - 1) '求和
        Next i

        s = s Mod 11   '取余数
        t = Mid(v, 18, 1)
        
        'If t = "x" Then
        '    t = "X"
        'End If
        
        If arr2(s) <> t Then  '判断是否与最后一位相等
            r = "末位代码应为" & arr2(s) & ";"
        End If
    End If
    examIdentityCardLastDigit = r
End Function

Function DelUnprintChar(s) As String
    r = ""
    For iPosition = 1 To Len(s) Step 1
        c = Mid(s, iPosition, 1)
        If ((c >= "0") And (c <= "9")) Or ((c >= "a") And (c <= "z")) Or ((c >= "A") And (c <= "Z")) Then
            r = r & c
        End If
    Next
    DelUnprintChar = r
End Function

Sub clearB()
    '清除B1:Bx原有的出错说明
    Range("b1", Cells(Rows.Count, "b").End(xlUp)).Clear
End Sub


Sub examIdentityCard()
    Dim r, s, v
    For Each Rng In Range("a1", Cells(Rows.Count, "a").End(xlUp))
        v = Rng.text

        '检查是否包含×
        If InStr(v, "×") > 0 Then
            v = Replace(v, "×", "X", 1, -1)
            Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X;"
        End If
    
        '检查是否包含全角大写x
        If InStr(v, "X") > 0 Then
            v = Replace(v, "X", "X", 1, -1)
            Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X;"
        End If
    
        '检查是否包含全角小写x
        If InStr(v, "x") > 0 Then
            v = Replace(v, "x", "X", 1, -1)
            Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X;"
        End If
    
        r = Len(v)
        v = DelUnprintChar(v)
        If Len(v) < r Then
            Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "包括多余字符;"
        End If

        If Len(v) = 15 Then
            r = exam15(v)
            If Len(r) <> 0 Then
                Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value + r
            End If
        ElseIf Len(v) = 18 Then
            If InStr(v, "x") > 0 Then
                v = UCase(v) '小写变大写
                Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "x应为X;"
            End If
        
            r = exam18(v)
            If Len(r) <> 0 Then
               Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value + r
            End If
        Else
            Range("B" & Rng.Row).Value = "身份证号码位数应为15或18位;"
        End If
Next


End Sub

以上是关于在EXCEL中VBA编程检验身份证号码有效性的主要内容,如果未能解决你的问题,请参考以下文章

怎么检测身份证号码是不是正确

VBA研究用VBA取得EXCEL随意列有效行数

VBA如何检验文件路径是不是正确?

excel身份证号码格式怎么设置

C#身份证号码验证器(检验格式是否正确)

VBA研究Excel文件间邮件号码对比筛重