VBA自定义身份证信息处理函数
1、中国居民身份证目前都已经升级到18位，其中每一位数字都有特殊的含义，说明如下：
①1-2 省级行政区代码
②3-4 地级行政区划分代码
③5-6 县区行政区分代码
④7-10 11-12 13-14 出生年、月、日
⑤15-17 顺序码，同一地区同年、同月、同日出生人的编号，奇数是男性，偶数是女性
⑥18 校验码，如果是0-9则用0-9表示，如果是10则用X（罗马数字10）表示
因此只要能够验证身份证号的正误，我们就可以根据居民身份证编码规则提取出生日期及性别，并进一步计算出年龄，那么如何判断证件号码正误呢？
第二代居民身份证拥有一套明确的校验位校验算法，第一步：获取余数，前17位号码与加权因子的乘积和除以11得出余数；第二步：用余数比照校验码对照表得出的校验码，再与身份证号最后一位比对，如一致则正确，否则证件错误。
1、自定义函数名CHECKID，包含两个参数：
参数1：ID_CODE，居民身份证号；
参数2：FUNCTION_NUM，返回值类型，1判断证件号码正误，2提取出生日期，3提取性别，4计算周岁年龄。
算法设计：
①出生日期：应用MID函数截取7-14位数字，再用text函数转换成日期；
②性别：顺序码为15-17位，但为简化计算取第17位即可，然后除以2取余。余数为0，则为“女”，反之为“男”；
③周岁年龄：当前年份减去出生年份得出一个值，再比较月份，如当前月份小于出生月，则年份差值再减去1为周岁年龄，反之大于，则年份差值为周岁年龄，如月份相同，则顺次再比较日。
1、Function CHECKID(ID_CODE As Range, FUNCTION_NUM As Integer)
Dim myReg As Object
Dim sum_num As Integer
factor = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2) '身份证号加权因子
Check_code = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2") '最后一位有效校验位
If Len(ID_CODE.Value) = 18 Then '判断是否为18位
Set myReg = CreateObject("Vbscript.regexp")
myReg.Pattern = "[A-Za-z0-9]{1}" '应用正则表达式分拆成18个1位数，此步可以应用mid函数，但正则表达式会效率会更高
myReg.Global = True
Set code = myReg.Execute(ID_CODE.Value)
For i = 0 To 16
sum_num = code(i) * factor(i) + sum_num
Next
If Check_code(sum_num Mod 11) = UCase(code(17)) Then
Select Case FUNCTION_NUM
Case 1 '判断证件号码是否正确
CHECKID = "正确"
Case 2 '提取出生日期
CHECKID = Application.WorksheetFunction.text(Mid(ID_CODE.Value, 7, 8), "0-00-00")
Case 3 '返回性别
If code(16) Mod 2 = 0 Then CHECKID = "女" Else CHECKID = "男"
Case 4 '返回周岁年龄
birthdate = Application.WorksheetFunction.text(Mid(ID_CODE.Value, 7, 8), "0-00-00")
If Month(birthdate) < Month(Date) Then
CHECKID = DateDiff("yyyy", birthdate, Date)
ElseIf Month(birthdate) > Month(Date) Then
CHECKID = DateDiff("yyyy", birthdate, Date) - 1
ElseIf Day(birthdate) > Day(Date) Then
CHECKID = DateDiff("yyyy", birthdate, Date) - 1
Else
CHECKID = DateDiff("yyyy", birthdate, Date)
End If
End Select
Else
CHECKID = "错误"
End If
Else
CHECKID = "非中国居民身份证"
End If
End Function
2、自定义函数应用效果
