以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  请教狐狸爸爸：Excel用VBA程序开发的身份证号码校验实例，如果转换成狐表的DatacolChanging事件来实现！！！  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=19875)
--  作者：lipiti
--  发布时间：2012/5/23 21:25:00
--  请教狐狸爸爸：Excel用VBA程序开发的身份证号码校验实例，如果转换成狐表的DatacolChanging事件来实现！！！

身份证号码校验实例




　　身份证号码是按照一定规律编制的，是个人身份的有效证明，每个人只有一个号码，且不会重复，因而被各单位各部门广泛应用在相关名册中。在大量的身份证号码录入过程中，由于抄写或录入等原因，可能会弄错了某位数字，如果录错了任何一位数字，计算出来的校验码就不一样。根据这一特点，本函数可以对已录入的大批量身份证号码进行校验，如果校验未通过，则说明你录入的号码中必定是某位数字错了，应及时更正，以保证身份证号码正确有效，如果录入的是第一代15位身份证号码，本函数将返回18位号码，使身份证号码保持统一的位数。
　　代码如下： 


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)) < 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
   End If
   Else
   IDcheck = ID & e                                                         \'15位身份证号码升位
End If
End Function                                                      



使用方法：

一、建立函数　

1、打开excel，点击菜单的“工具→宏→录制新宏”，弹出录制新宏对话框。

　　


2、在“保存在”下面选择“个人宏工作簿”，点击确定。（选择个人宏工作簿有2大好处：①使本函数可应用于当前计算机中所有的excel工作表；②不受宏安全性设置高低的影响。）




3、在弹出的录制宏工具中点击“停止录制”按钮，结束宏的录制。




4、点击菜单的“工具→宏→Visual Basic 编辑器”，打开编辑器。



5、在编辑器中可以看到刚才录制的代码“Sub macrol()　”，还有录制时间等内容。选中编辑器中的代码并删除。
     注：如果编辑器中没有出现PERSONAL.XLS - 模块1（代码），请在左边“工程资源管理器”中找到PEROSNAL.XLS下面的模块1并双击。




6、把以上代码复制到编辑器中，保存并退出编辑器。至此，你就可以使用本函数了。



　

二、函数的使用

1、打开名册，点击身份证号码后面用于存放校验结果的空白单元格，点击插入函数按钮 fx ，弹出插入函数对话框。




2、在“选择类别”中选择“用户定义”类。




3、可以看到“选择函数”下面出现了刚才保存的 PERSONAL.XLS!IDcheck 函数，选中该函数，点击确定按钮，弹出“函数参数”对话框。




4、点击工作表上对应的身份证号码单元格（下图为A2单元格），点击“确定”按钮。




5、然后向下填充，得到其他身份证号码的检验结果。

[此贴子已经被作者于2012-5-23 21:25:56编辑过]
--  作者：lipiti
--  发布时间：2012/5/23 22:02:00
--  
第二种VBA参考方法

\'计算身份证末位验证字符
Function IdCardLastChar(num)
    Dim cId As String
    Dim nsum As Integer
    Dim check_number As String
    
    If Len(num) = 15 Then
        cId = Left(num, 6) & "19" & Right(num, 9)
    ElseIf Len(num) = 17 Or Len(num) = 18 Then
        cId = Left(num, 17)
    End If
    \'计算方法
    nsum = Mid(cId, 1, 1) * 7
    nsum = nsum + Mid(cId, 2, 1) * 9
    nsum = nsum + Mid(cId, 3, 1) * 10
    nsum = nsum + Mid(cId, 4, 1) * 5
    nsum = nsum + Mid(cId, 5, 1) * 8
    nsum = nsum + Mid(cId, 6, 1) * 4
    nsum = nsum + Mid(cId, 7, 1) * 2
    nsum = nsum + Mid(cId, 8, 1) * 1
    nsum = nsum + Mid(cId, 9, 1) * 6
    nsum = nsum + Mid(cId, 10, 1) * 3
    nsum = nsum + Mid(cId, 11, 1) * 7
    nsum = nsum + Mid(cId, 12, 1) * 9
    nsum = nsum + Mid(cId, 13, 1) * 10
    nsum = nsum + Mid(cId, 14, 1) * 5
    nsum = nsum + Mid(cId, 15, 1) * 8
    nsum = nsum + Mid(cId, 16, 1) * 4
    nsum = nsum + Mid(cId, 17, 1) * 2
    \'*计算校验位
    check_number = 12 - nsum Mod 11
    If check_number = 10 Then
        check_number = "X"
    End If
    If check_number = 12 Then
        check_number = "1"
    End If
    If check_number = 11 Then
        check_number = "0"
    End If
    IdCardLastChar = check_number
End Function
--  作者：狐狸爸爸
--  发布时间：2012/5/24 7:57:00
--  

参考：
http://www.foxtable.com/help/topics/0320.htm


http://www.foxtable.com/help/topics/0321.htm


 
 
至于末位校验，自己先了解验证规则，然后编写。
--  作者：lipiti
--  发布时间：2012/5/24 18:11:00
--  
关键是参考的两个引出出生日期和性别，已经都在使用了，最最主要的还是末位校正，希望狐狸爸爸还是能给出官方的代码
因为这个例子通用性很强，如果有官方的代码，广大用户都能受益，对狐表本身强大的功能也能得到展示。
--  作者：擎天柱
--  发布时间：2012/5/25 20:53:00
--  
我2年前前用表达式做了一个，15位转18位的，公式比较复杂，不妨参考一下：

用表达式提取身份证号码信息 【更新】

http://www.foxtable.com/bbs/dispbbs.asp?BoardID=2&ID=6388&replyID=&skin=1
[此贴子已经被作者于2012-5-25 20:53:56编辑过]
--  作者：lipiti
--  发布时间：2012/5/25 21:07:00
--  
谢谢楼上！这个对我们很有用。
正在研究末尾的校正码表达式：
IIF(LEN([ID])=18,
IIF(
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
Convert(SUBSTRING([ID],7,1),System.Int16)*2+
Convert(SUBSTRING([ID],8,1),System.Int16)*1+
Convert(SUBSTRING([ID],9,1),System.Int16)*6+
Convert(SUBSTRING([ID],10,1),System.Int16)*3+
Convert(SUBSTRING([ID],11,1),System.Int16)*7+
Convert(SUBSTRING([ID],12,1),System.Int16)*9+
Convert(SUBSTRING([ID],13,1),System.Int16)*10+
Convert(SUBSTRING([ID],14,1),System.Int16)*5+
Convert(SUBSTRING([ID],15,1),System.Int16)*8+
Convert(SUBSTRING([ID],16,1),System.Int16)*4+
Convert(SUBSTRING([ID],17,1),System.Int16)*2)%11)=2,\'X\',
IIF(
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
Convert(SUBSTRING([ID],7,1),System.Int16)*2+
Convert(SUBSTRING([ID],8,1),System.Int16)*1+
Convert(SUBSTRING([ID],9,1),System.Int16)*6+
Convert(SUBSTRING([ID],10,1),System.Int16)*3+
Convert(SUBSTRING([ID],11,1),System.Int16)*7+
Convert(SUBSTRING([ID],12,1),System.Int16)*9+
Convert(SUBSTRING([ID],13,1),System.Int16)*10+
Convert(SUBSTRING([ID],14,1),System.Int16)*5+
Convert(SUBSTRING([ID],15,1),System.Int16)*8+
Convert(SUBSTRING([ID],16,1),System.Int16)*4+
Convert(SUBSTRING([ID],17,1),System.Int16)*2)%11) IN (\'1\',\'0\')
,1-
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
Convert(SUBSTRING([ID],7,1),System.Int16)*2+
Convert(SUBSTRING([ID],8,1),System.Int16)*1+
Convert(SUBSTRING([ID],9,1),System.Int16)*6+
Convert(SUBSTRING([ID],10,1),System.Int16)*3+
Convert(SUBSTRING([ID],11,1),System.Int16)*7+
Convert(SUBSTRING([ID],12,1),System.Int16)*9+
Convert(SUBSTRING([ID],13,1),System.Int16)*10+
Convert(SUBSTRING([ID],14,1),System.Int16)*5+
Convert(SUBSTRING([ID],15,1),System.Int16)*8+
Convert(SUBSTRING([ID],16,1),System.Int16)*4+
Convert(SUBSTRING([ID],17,1),System.Int16)*2)%11)
,12-
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
Convert(SUBSTRING([ID],7,1),System.Int16)*2+
Convert(SUBSTRING([ID],8,1),System.Int16)*1+
Convert(SUBSTRING([ID],9,1),System.Int16)*6+
Convert(SUBSTRING([ID],10,1),System.Int16)*3+
Convert(SUBSTRING([ID],11,1),System.Int16)*7+
Convert(SUBSTRING([ID],12,1),System.Int16)*9+
Convert(SUBSTRING([ID],13,1),System.Int16)*10+
Convert(SUBSTRING([ID],14,1),System.Int16)*5+
Convert(SUBSTRING([ID],15,1),System.Int16)*8+
Convert(SUBSTRING([ID],16,1),System.Int16)*4+
Convert(SUBSTRING([ID],17,1),System.Int16)*2)%11)
))
,IIF(LEN([ID])=15,

IIF(
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
2+
9+
Convert(SUBSTRING([ID],7,1),System.Int16)*6+
Convert(SUBSTRING([ID],8,1),System.Int16)*3+
Convert(SUBSTRING([ID],9,1),System.Int16)*7+
Convert(SUBSTRING([ID],10,1),System.Int16)*9+
Convert(SUBSTRING([ID],11,1),System.Int16)*10+
Convert(SUBSTRING([ID],12,1),System.Int16)*5+
Convert(SUBSTRING([ID],13,1),System.Int16)*8+
Convert(SUBSTRING([ID],14,1),System.Int16)*4+
Convert(SUBSTRING([ID],15,1),System.Int16)*2)%11)=2,\'X\',
IIF(
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
2+
9+
Convert(SUBSTRING([ID],7,1),System.Int16)*6+
Convert(SUBSTRING([ID],8,1),System.Int16)*3+
Convert(SUBSTRING([ID],9,1),System.Int16)*7+
Convert(SUBSTRING([ID],10,1),System.Int16)*9+
Convert(SUBSTRING([ID],11,1),System.Int16)*10+
Convert(SUBSTRING([ID],12,1),System.Int16)*5+
Convert(SUBSTRING([ID],13,1),System.Int16)*8+
Convert(SUBSTRING([ID],14,1),System.Int16)*4+
Convert(SUBSTRING([ID],15,1),System.Int16)*2)%11) IN (\'1\',\'0\')
,1-
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
2+
9+
Convert(SUBSTRING([ID],7,1),System.Int16)*6+
Convert(SUBSTRING([ID],8,1),System.Int16)*3+
Convert(SUBSTRING([ID],9,1),System.Int16)*7+
Convert(SUBSTRING([ID],10,1),System.Int16)*9+
Convert(SUBSTRING([ID],11,1),System.Int16)*10+
Convert(SUBSTRING([ID],12,1),System.Int16)*5+
Convert(SUBSTRING([ID],13,1),System.Int16)*8+
Convert(SUBSTRING([ID],14,1),System.Int16)*4+
Convert(SUBSTRING([ID],15,1),System.Int16)*2)%11)
,12-
((Convert(SUBSTRING([ID],1,1),System.Int16)*7+
Convert(SUBSTRING([ID],2,1),System.Int16)*9+
Convert(SUBSTRING([ID],3,1),System.Int16)*10+
Convert(SUBSTRING([ID],4,1),System.Int16)*5+
Convert(SUBSTRING([ID],5,1),System.Int16)*8+
Convert(SUBSTRING([ID],6,1),System.Int16)*4+
2+
9+
Convert(SUBSTRING([ID],7,1),System.Int16)*6+
Convert(SUBSTRING([ID],8,1),System.Int16)*3+
Convert(SUBSTRING([ID],9,1),System.Int16)*7+
Convert(SUBSTRING([ID],10,1),System.Int16)*9+
Convert(SUBSTRING([ID],11,1),System.Int16)*10+
Convert(SUBSTRING([ID],12,1),System.Int16)*5+
Convert(SUBSTRING([ID],13,1),System.Int16)*8+
Convert(SUBSTRING([ID],14,1),System.Int16)*4+
Convert(SUBSTRING([ID],15,1),System.Int16)*2)%11)
))
,\'\'))
--  作者：擎天柱
--  发布时间：2012/5/26 10:09:00
--  
楼主不要研究这个公式，他会让你变糊涂的，直接套用即可。如过你想搞懂它，你找相关的身份证校验码的有关资料，看懂它的算法，根据这个算法，寻找规律，再根据数字规律，编写狐表的表达式公式即可。表达式有局限性，如果用代码可能会简洁些。这是2年前的东西，我未再跟进研究。工作原因，很长时间没学习狐表了。
--  作者：lipiti
--  发布时间：2012/5/26 22:45:00
--  
嗯，非常感谢楼上，表达式已经套用了。