在Excel中检验身份证号

　　近几日，我的工作是录入更正的农业直补农户资料，涉及到了各包村*上报的各种样式的报表，经会计清点后，由我来统一按上报的格式来摘抄到上报表中。据会计说，我的字写得还过得去，比小代强。

　　我建议用计算机来处理，打字比写字可快多了，还清楚。

　　下面的工作，就是录入一大堆的编号和身份证号以及姓名。姓名不是难事，在录入几十个后，我越发的想去上网，把读霸安装上，我打它来读，这样就不用抬头看屏幕了。想到乡里网吧的半个小时打开一封邮件的速度呀，我还是放弃了。

　　身份证可是不能再错误了，幸好我的电子书里有一段关于身份证格式的说明和程序，在稍加修改后，它已经可以用来批量的判断身份证是不是有格式（包括长度，出生年月，验证位）的错误。

　　本想通过数据有效性来作，只是公式里不能调用VBA的函数，真是郁闷。

 

　　下次有机会，改写一个公式来判断的。

 

 

Sub  检验选定区域身份证()
'
'  检验身份证 Macro
'  用于检测身份证号码是否正确
'
'  快捷键: Ctrl+q
'
Dim  arange  As  range
Dim  acell  As  range
Dim  ret  As   Integer
Set  arange  =  Selection
For   Each  acell In arange.Cells
   ' MsgBox ActiveCell.Text
    ret  =  IDCheck( UCase (acell.Text))
     If  ret  <>   0   Then
        acell.Select
         MsgBox   " 请检查当前选定单元格的身份证是否正确 " , ,  " 提示 "
         Exit   Sub
     End   If
    
    
Next
     MsgBox   " 全部正确 " , ,  " 提示 "
End Sub
Function  CurrentIdCheck()  As   Integer
Dim  ret  As   Integer
' MsgBox ActiveCell.Text
' ret = IDCheck(ActiveCell.Text)
' MsgBox ret
' CurrentIdCheck = ret
CurrentIdCheck  =   0
End Function
Function  IDCheck(ByVal e  As   String )  As   Integer
  Dim  arrVerifyCode
  Dim  Wi
  Dim  Checker
  Dim  BirthDay
 IDCheck  =   0   ' 验证通过时返回
 arrVerifyCode  =   Split ( " 1,0,X,9,8,7,6,5,4,3,2 " ,  " , " )
 Wi  =   Split ( " 7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2 " ,  " , " )
 Checker  =   Split ( " 1,9,8,7,6,5,4,3,2,1,1 " ,  " , " )
  If   Len (e)  <   15   Or   Len (e)  =   16   Or   Len (e)  =   17   Or   Len (e)  >   18   Then
  ' IDCheck= "身份证号必须是15位数或18位数！"
 IDCheck  =   1
  Exit   Function
  End   If
  Dim  Ai  As   String
  If   Len (e)  =   18   Then
 Ai  =   Mid (e,  1 ,  17 )
  ElseIf   Len (e)  =   15   Then
 Ai  =   CStr (e)
 Ai  =   Left (Ai,  6 )  &   " 19 "   &   Mid (Ai,  7 ,  9 )
  End   If
  If   Not   IsNumeric (Ai)  Then
  ' IDCheck= "身份证除最后一位外，必须为数字！"
 IDCheck  =   2
  Exit   Function
  End   If
  Dim  strYear  As   Integer
  Dim  strMonth  As   Integer
  Dim  strDay  As   Integer
 strYear  =   CInt ( Mid (Ai,  7 ,  4 ))
 strMonth  =   CInt ( Mid (Ai,  11 ,  2 ))
 strDay  =   CInt ( Mid (Ai,  13 ,  2 ))
 BirthDay  =   Trim (strYear)  +   " - "   +   Trim (strMonth)  +   " - "   +   Trim (strDay)
  If   IsDate (BirthDay)  Then
  If   DateDiff ( " yyyy " ,  Now (),  CDate (BirthDay))  <   - 140   Or   CDate (BirthDay)  >   Now ()  Then
  ' IDCheck= "身份证输入错误（日期输入错误）！"
 IDCheck  =   3
  Exit   Function
  End   If
  If  strMonth  >   12   Or  strDay  >   31   Then
  ' IDCheck= "身份证输入错误（日期输入错误）！"
 IDCheck  =   3
  Exit   Function
  End   If
  Else
  ' IDCheck= "身份证输入错误（日期输入错误）！"
 IDCheck  =   3
  Exit   Function
  End   If
  Dim  i  As   Integer
  Dim  TotalmulAiWi  As   Integer
  For  i  =   0   To   16
 TotalmulAiWi  =  TotalmulAiWi  +   CInt ( Mid (Ai, i  +   1 ,  1 ))  *   CInt (Wi(i))
  Next
  Dim  modValue  As   Integer
 modValue  =  TotalmulAiWi  Mod   11
  Dim  strVerifyCode  '  As Object
 strVerifyCode  =  arrVerifyCode(modValue)
 Ai  =  Ai  &  strVerifyCode
  If   Len (e)  =   18   And   CStr (e)  <>  Ai  Then
  ' IDCheck= "身份证号码输入错误（身份证包含有非法字符）！"
 IDCheck  =   4
  Exit   Function
  End   If
  End Function