在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 Thenv = Replace(v, "×", "X", 1, -1)Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X；"End If'检查是否包含全角大写xIf InStr(v, "Ｘ") > 0 Thenv = Replace(v, "Ｘ", "X", 1, -1)Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X；"End If'检查是否包含全角小写xIf InStr(v, "ｘ") > 0 Thenv = Replace(v, "ｘ", "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 Stringr = ""For iPosition = 1 To Len(s) Step 1c = Mid(s, iPosition, 1)If ((c >= "0") And (c <= "9")) Or ((c >= "a") And (c <= "z")) Or ((c >= "A") And (c <= "Z")) Thenr = r & cEnd IfNextDelUnprintChar = r
End Function

完整的代码如下（身份证号码数据在A1:Ax，数据错误显示在B1:Bx）。：


Function exam18(v) As StringDim cd1, rr = ""'下面检验出生日期是否正确cd1 = Mid(v, 7, 4) & "-" & Mid(v, 11, 2) & "-" & Mid(v, 13, 2)If Not IsDate(cd1) Thenr = "出身日期" & cd1 & "无效；"Elser = examIdentityCardLastDigit(v)End Ifexam18 = r
End FunctionFunction exam15(v) As String'对15位身份证号码进行校验Dim a, rr = ""'是否全数字If Not IsNumeric(r) Thenr = "15位身份证号码应全是数字；"Else'下面检验出生日期是否正确a = Mid(v, 7, 2) & "-" & Mid(v, 9, 2) & "-" & Mid(v, 11, 2)If Not IsDate(a) Thenr = "出生日期" + a + "无效；"End IfEnd Ifexam15 = r
End FunctionFunction examIdentityCardLastDigit(v) As StringDim i, arr1(), arr2(), r, sarr1 = 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) Thenr = "身份证号码前17位应是数字；"Elses = 0For i = 1 To 17t = Mid(v, i, 1) '取出每位数s = s + t * arr1(i - 1) '求和Next is = s Mod 11   '取余数t = Mid(v, 18, 1)'If t = "x" Then'    t = "X"'End IfIf arr2(s) <> t Then  '判断是否与最后一位相等r = "末位代码应为" & arr2(s) & "；"End IfEnd IfexamIdentityCardLastDigit = r
End FunctionFunction DelUnprintChar(s) As Stringr = ""For iPosition = 1 To Len(s) Step 1c = Mid(s, iPosition, 1)If ((c >= "0") And (c <= "9")) Or ((c >= "a") And (c <= "z")) Or ((c >= "A") And (c <= "Z")) Thenr = r & cEnd IfNextDelUnprintChar = r
End FunctionSub clearB()'清除B1:Bx原有的出错说明Range("b1", Cells(Rows.Count, "b").End(xlUp)).Clear
End SubSub examIdentityCard()Dim r, s, vFor Each Rng In Range("a1", Cells(Rows.Count, "a").End(xlUp))v = Rng.text'检查是否包含×If InStr(v, "×") > 0 Thenv = Replace(v, "×", "X", 1, -1)Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X；"End If'检查是否包含全角大写xIf InStr(v, "Ｘ") > 0 Thenv = Replace(v, "Ｘ", "X", 1, -1)Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X；"End If'检查是否包含全角小写xIf InStr(v, "ｘ") > 0 Thenv = Replace(v, "ｘ", "X", 1, -1)Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "×应为X；"End Ifr = Len(v)v = DelUnprintChar(v)If Len(v) < r ThenRange("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "包括多余字符；"End IfIf Len(v) = 15 Thenr = exam15(v)If Len(r) <> 0 ThenRange("B" & Rng.Row).Value = Range("B" & Rng.Row).Value + rEnd IfElseIf Len(v) = 18 ThenIf InStr(v, "x") > 0 Thenv = UCase(v) '小写变大写Range("B" & Rng.Row).Value = Range("B" & Rng.Row).Value & "x应为X；"End Ifr = exam18(v)If Len(r) <> 0 ThenRange("B" & Rng.Row).Value = Range("B" & Rng.Row).Value + rEnd IfElseRange("B" & Rng.Row).Value = "身份证号码位数应为15或18位；"End If
NextEnd Sub

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

Excel中VBA编程学习笔记（一）
1.注释及编码规则注释: 单引号:可以位于句子结尾或者单独一行: Rem:单独一行编码规则: 如果VB中的关键字是由多个英文字母组成,则系统自动将每个单词的首字母转换成大写字母,其余字母一律转换成 ...
excel中怎么快速录入身份证号码？
1.如下图要求在单元格中快速录入身份号码 2.首先我们选中要录入号码的单元格,然后点击[DIY工具箱] 3.点击[身份证]选择[输入身份证号] 4.身份证号码录入完成后点击[确定] 5.这样就可以 ...
Excel中VBA编程学习笔记（十一）--正则表达式
在VBA中使用正则表达式受限需要引用Microsoft VBScript Regular Expressions 5.5类库.在VBA界面,"工具"-->"引用&q ...
Excel中VBA编程学习笔记（七）--窗口应用(WINDOW)
1.修改并获取当前窗口标题 Private Sub test() Windows(1).Caption = "My Excel" MsgBox ("当前窗口标题:&quo ...
Excel中VBA编程学习笔记（十二）--自动筛选
Range.AutoFIlter方法可以进行自动筛选,语法结构如下: Range.AutoFilter(Field,Criteria1Operator,Criteria2,VIsibleDropDow ...
Excel中VBA编程学习笔记（十）--单元格(cell)
1.单元格引用引用含义 Range("A1") 单元格A1 Range("A1:B2") A1到B2的单元格区域 Range("C5:D9,G9: ...
Excel中VBA编程将大写人民币转阿拉伯数字
实际应用中大多数需求都是阿拉伯数字转大写人民币很少有反过来的需求. 可是,有轮子用它不香吗>.< Sub ChangeMoneyToNum() Dim reg As Object, a ...
EXCEL中如何提取身份证出生日期和性别信息以及检验身份证号码的正确性
中国居民身份证号码是一组特征组合码,原为15位,现升级为18位,其编码规则为: 15位:6位数字常住户口所在县市的行政区划代码,6位数字出生日期代码,3位数字顺序码. 18位:6位数字常住户口所在县市 ...
Excel与VBA编程中的常用代码
Excel与VBA编程中的常用代码用过VB的人都应该知道如何声明变量,在VBA中声明变量和VB中是完全一样的! 使用Dim语句 Dim a as integer '声明A为整形变量 Dim a '声 ...

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

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

最新文章

热门文章