ExcelTip.Net留存知识帖 ---【注:附件之前被网盘供应商清空后,现已修复-现已修复-现已修复为本地下载!】
现在位置:首页 > E问E答 > Excel VBA > 如何编写自定义函数验证身份证号码的合法性?

如何编写自定义函数验证身份证号码的合法性?

作者:绿色风 分类: 时间:2022-08-17 浏览:110
楼主
amulee
Q:如何编写自定义函数验证身份证号码的合法性?
A:验证身份证号码要进行多个判断,要验证区域码是否合法,出生日期是否合法,校验码是否合法。本例中对上述几项进行验证判断。由于区域码数据库可能不完全,所以可以不考虑该验证。参考代码如下:
  1. Function IsIDNumber(ByVal IDNumber As String) As Boolean
  2.     Dim SumM&
  3.     Dim strTemp$
  4.     '将英文转换成大写
  5.     IDNumber = UCase(Trim(IDNumber))
  6.     '先看前N位,不是数字就退出
  7.     If Not IsNumeric(Left(IDNumber, 17)) Then Exit Function
  8. '    '再看前6位,不在数据库退出。数据库仅作参考
  9. '    If Sheet2.Range("A:A").Find(Left(IDNumber, 6), lookat:=xlWhole) Is Nothing Then Exit Function
  10.     '分别对待15位和18位,
  11.     Select Case Len(IDNumber)
  12.         '15位看日期
  13.         Case 15
  14.             strTemp = Mid(IDNumber, 7, 6)
  15.             If strTemp = Format(DateSerial(Left(strTemp, 2), Mid(strTemp, 3, 2), Right(strTemp, 2)), "yymmdd") Then IsIDNumber = True
  16.         '18位看校验码
  17.         Case 18
  18.             '看校验码是否符合范围
  19.             If Not IDNumber Like "*[0-9X]" Then Exit Function
  20.             '看日期
  21.             strTemp = Mid(IDNumber, 7, 8)
  22.             If strTemp <> Format(DateSerial(Left(strTemp, 4), Mid(strTemp, 5, 2), Right(strTemp, 2)), "yyyymmdd") Then Exit Function
  23.             '看校验码是否正确
  24.             For i = 1 To 17
  25.                 SumM = CInt(Mid(IDNumber, i, 1)) * 2 ^ (18 - i) + SumM
  26.             Next
  27.             If Right(IDNumber, 1) = Mid("10X98765432", (SumM Mod 11) + 1, 1) Then IsIDNumber = True
  28.         Case Else
  29.     End Select
  30. End Function



附件下载:
身份证号码验证.rar
2楼
天鹏
能否写一个不验证开始6位数的宏,只检验证是否为15位或者为18位,验证出生日期,比如月份1月、3月、5月、7月、8月、10月、12月有31天,除2月平年为28天,闰年为29天,其它月为30日,和识别码的验证,以及大小写的X都能验证的宏!就好了!

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素, 经与ExcelTip.Net站长Apolloh商议并征得其同意, 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示, 供有需要的人士查询使用,也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议, 可与本人沟通提出,或于本站点留言,我们会尽快处理。 在此,感谢ExcelTip.Net站长Apolloh的支持,感谢本站点所有人**绿色风(QQ:79664738)**的支持与奉献,特此鸣谢!
------本人网名**KevinChengCW(QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表
sitemap