求助检查身份证检查

qiongmei6 · 发表于 2023-4-5 09:06

我想求得一个身份证检查的代码，y列是已经输入好的身份证，我希望执行他能检查出身份证的错误，例如身份证没输入18位，身份证含有字母没有大写，身份证含有出生年月日的错误，例如有个身份是2021-10-23，结果身份证号变成440902202123101562等等这类执行检查按钮就可以检查出来的，我希望这个程序能配合我其他程序一起执行，在正确的时候不影响其他程序执行，错误的时候弹出提示“xx身份证错误”，例如表格中张7的身份证错误，按检查的时候提示“张7身份证号错误”，谢谢高手师傅的帮忙

chenjy267 · 发表于 2023-4-5 10:40

就简单拆分条件判断

opiona · 发表于 2023-4-5 10:41

Rem **********************************************************************************************
Rem 函数名： CheckSFZCardID
Rem 函数功能：检查身份证号码是否合规则
Rem 返回值：返回布尔类型
Rem 参数1： CardID 字符类型身份证号码
Rem 参数2： StrOUT 文本类型要什么结果: 出生日期,性别,对比结果默认是=对比结果
Rem 参数3： TiShi 布尔类型是否显示错误信息
Rem 使用方法： MsgBox CheckCardID_SFZ(CardID:=StrID, StrOUT:="" ,TiShi:=True)
Rem 整理：北极狐工作室 QQ：14885553
Rem ***********************************************************************************************
Public Function CheckCardID_SFZ(ByVal CardID As String, Optional StrOUT As String = "对比结果", Optional TiShi As Boolean = True)
Dim Exception, StrAddSF As String
Dim ARR, BRR, SHUZI, ZAD
Dim WEI, YAN1, YAN2 As Integer
Dim DATEX As String
Dim BOOL As Boolean
Application.Volatile '//自动计算自定义函数
BOOL = True '//假设正确
Exception = ""
If StrOUT = "" Then StrOUT = "对比结果" '//性别,出生日期
Set ZAD = CreateObject("Scripting.Dictionary")
If Len(CardID) <> 18 Then
Rem 限定身份证号是18位
BOOL = False
Exception = Exception & vbCrLf & "身份证号必须是：18位"
Else
Rem 省份验证
StrAddSF = "11x22x35x44x53x12x23x36x45x54x13x31x37x46x61x14x32x41x50x62x15x33x42x51x63x21x34x43x52x64x65x71x81x82x91"
If InStr(StrAddSF, Mid(CardID, 1, 2)) = 0 Then
Exception = Exception & vbCrLf & "省份部分有误"
BOOL = False
End If
Rem 校验前17位是否为数字/检验第18位校验码是否正确
ARR = Array("7", "9", "10", "5", "8", "4", "2", "1", "6", "3", "7", "9", "10", "5", "8", "4", "2")
BRR = Array("1", "0", "x", "9", "8", "7", "6", "5", "4", "3", "2")
For WEI = 1 To 17
SHUZI = Mid(CardID, WEI, 1)
If IsNumeric(SHUZI) = False Then
BOOL = False
Exception = Exception & vbCrLf & "您可能输入了非法字符"
Else
YAN1 = YAN1 + SHUZI * ARR(WEI - 1)
End If
Next
If Exception = "" Then
Rem 校验码正确
YAN2 = YAN1 Mod 11
If UCase(Mid(CardID, 18)) <> UCase(BRR(YAN2)) Then
BOOL = False
Exception = Exception & vbCrLf & "校验码不符"
End If
Rem '限定出生日期范围为1920.1.1-2100.1.1/消息框提示再次确认出生日期、性别
DATEX = Mid(CardID, 7, 4) & "-" & Mid(CardID, 11, 2) & "-" & Mid(CardID, 13, 2)
If IsDate(DATEX) = False Then
BOOL = False
Exception = Exception & vbCrLf & "输入的出生时间可能有误"
Else
DATEX = Format(DATEX, "yyyy-MM-dd")
If DateDiff("D", "1901-01-01", DATEX) > 0 And DateDiff("D", "2101-01-01", DATEX) < 0 Then
ZAD("出生日期") = DATEX
If InStr("13579", Mid(CardID, 17, 1)) > 0 Then
ZAD("性别") = "男"
Else
ZAD("性别") = "女"
End If
Else
BOOL = False
Exception = Exception & vbCrLf & "输入的出生时间超范围"
End If
End If
End If
End If
Rem 输出结果
If Exception = "" Then
Rem 无错误,正常输出
ZAD("对比结果") = BOOL
CheckCardID_SFZ = ZAD(StrOUT)
Else
Rem 如果有错误
If TiShi = True Then
Rem 直接输出错误信息
CheckCardID_SFZ = Exception
Else
Rem 根据要求选择输出值
Select Case StrOUT
Case "对比结果"
CheckCardID_SFZ = False
Case "性别"
CheckCardID_SFZ = ""
Case "出生日期"
CheckCardID_SFZ = ""
Case Else
CheckCardID_SFZ = False
End Select
End If
End If
End Function

复制代码

yylucke · 发表于 2023-4-5 11:04

yylucke · 发表于 2023-4-5 11:05

请参见附件

Book1.rar (51.14 KB, 下载次数: 11)

qiongmei6 · 发表于 2023-4-5 11:13

yylucke 发表于 2023-4-5 11:05
请参见附件

谢谢yylucke师傅的回答，这个代码输入正确的身份证一样显示是错误，能否麻烦您再帮我看下

qiongmei6 · 发表于 2023-4-5 11:29

谢谢yylucke师傅，但是我执行的时候输入正确的身份证一样提示错误，能否麻烦你看看是啥问题

蓝桥玄霜 · 发表于 2023-4-5 11:35

检查的例子：

yylucke · 发表于 2023-4-5 16:26

qiongmei6 发表于 2023-4-5 11:29
谢谢yylucke师傅，但是我执行的时候输入正确的身份证一样提示错误，能否麻烦你看看是啥问题

已经修改

Book1.rar (56.78 KB, 下载次数: 9)

高个子 · 发表于 2023-4-5 16:34

其实这个只能判断合不合规则，但是想要知道这是不是真实的身份证那得去公安那里查。。

		自动登录	找回密码
密码			免费注册

[求助] 求助检查身份证检查

评分