在工作中有时要用到检验身份证号的逻辑正确性，有时要根据性别、出生日期来随机生成身份证号

随机生成身份证用法：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
或者淘宝联系店长：