EXCEL VBA 身份证号检验函数
2017-03-27 20:20阅读：
在工作中有时要用到检验身份证号的逻辑正确性，有时要根据性别、出生日期来随机生成身份证号
随机生成身份证用法：sfzh(sex,year,month,day)
sex为性别，year为出生年份，month为出生月份，day为出生的日期
Function sfzh(sex, year, month, day)
Dim idadd As String
Dim m, d As String
r = Application.RandBetween(1, 5)
If sex = '男' Then
rs = Mid('13579', r,
1)
Else
rs = Mid('02468', r, 1)
End If
'临海市身份证号地址位编码规则 身份证号地址位：332602
1975-1980
身份证号地址位：331082
1981~
身份证号地址位：332621 ~1974
If year < 1975 Then
idadd = '332621'
ElseIf year > 1980 Then
idadd = '331082'
Else
idadd = '332602'
End If
If month < 10 Then
m = '0' & month
Else
m = month
End If
If day < 10 Then
d = '0' & day
Else
d = day
End If
sfzh1 = idadd & year & m & d &
Application.RandBetween(0, 9) & Application.RandBetween(0,
9)
& rs
sfzh = sfzh1 & IDcheck(sfzh1 & 'A')
End Function
'身份证号码校验函数
Function IDcheck(ID)
Dim s, i As Integer
Dim e, z As String
Part1: '----------------------------身份证号码合法性检查
If Not (Len(ID) = 18 Or Len(ID) = 15) Then
'位数检验
IDcheck = '位数错误'
Exit Function
Else
If Len(ID) = 15 Then ID =
Left(ID, 6) & '19' & Right(ID, 9)
If IsNumeric(Left(ID, 17)) =
False Or InStr(ID, '.') > 0 Then
'字符检验
IDcheck = '字符错误'
Exit Function
End If
On Error Resume Next
'日期检验
If DateValue(Mid(ID, 7, 4)
& '-' & Mid(ID, 11, 2) & '-' & Mid(ID, 13, 2))
<<br> 1 Or DateValue(Mid(ID, 7, 4) & '-' & Mid(ID,
11, 2) &
'-' & Mid(ID, 13, 2)) > Date Then
IDcheck = '日期错误'
Exit Function
End If
End If
Part2: '-----------------------------校验码的生成及检查
s = 0
For i = 1 To 17
s = s Val(Mid(ID, 18 - i,
1)) * (2 ^ i Mod 11)
Next
e = Mid('10X98765432', (s Mod 11) 1, 1)
'生成校验码
If Len(ID) = 18 Then
z = UCase(Right(ID, 1))
If z = e Then
'校验码对比
IDcheck = '通过'
Else
IDcheck =
'校验未通过'
'如果要返回校验码，请把本行语句改为: IDcheck = e
IDcheck = e
End If
Else
IDcheck = ID & e
'15位身份证号码升位
End If
End Function
如您有程序开发、数据挖掘、统计分析、医学科研咨询请加QQ：2285001661
或者淘宝联系店长：
https://item.taobao.com/item.htm?id=547877122599
