10年前写的，身份证号码验证VBA代码

工作中经常与身份证号码打交道，现在各类信息系统都把身份证号码作为识别定义人员的关键字段，下面这段代码，在我的工作中发挥了极其重要的作用！分享出来，希望能帮助到更多的人！

10年前写的，if套if，格式不规范，也不够简练，但用起来还是挺好用的！不再改了！

函数入参就1个，已经在代码里面注明了。

函数返回结果共7种，分别是：

身份证号码格式问题：

1. Err01_身份证号码格式错误;
2. Err05_身份证号码末位须为半角数字或字母X;
3. Err06_身份证号码前17位须为半角数字;
4. Err07_身份证号码必须是18位;

身份证号码出生年月日（第7位至第14位）错误：

1. Err02_身份证号码错误;
2. Err03_身份证号码错误;

身份证号码校验错误：

1. Err04_身份证号码校验错误;

使用方法很简单，按Alt+F11，【插入】—【模块】，粘贴下面代码。在单元格中输入：

=CheckID(单元格地址)

即可校验指定单元格内身份证号码有效性。

'=====================================
'函数名称：CheckID
'
'函数作用：验证身份证号码是否有效
'
'参    数：cid，身份证号码，String类型
'
'返 回 值：错误信息，String类型
'
'作    者：w2kexp@csdn
'
'编写日期：2013-11-13
'=====================================
Function CheckID(ByVal cid As String)
 Dim rn As Boolean '闰年标志
 Dim DaysFebruary As Integer  '2月份天数
 Dim DaysPerMonth       	  '每月天数
	Select Case Len(cid)
    Case 18                                                                                                                              '当身份证号码为18位时
    If IsNumeric(Left(cid, 17)) Then
        If IsNumeric(Right(cid, 1)) Or Right(cid, 1) = "X" Then                                                                          '如果最后一位是数字或"X"时，判断是否为闰年
                 If Int(Mid(cid, 7, 2)) < 18 Or Int(Mid(cid, 7, 2)) > 20 Or Int(Mid(cid, 11, 2)) < 1 Or Int(Mid(cid, 11, 2)) > 12 Then
                    CheckID = "Err01_身份证号码格式错误;"
                    Exit Function

                 Else

                  '如果年、月格式正确，开始判断每月天数
                        If Mid(cid, 8, 3) = "000" And Int(Mid(cid, 7, 4)) Mod 400 = 0 Then            '如果是世纪年，且能被400整除，为闰年
                             rn = True
                        Else
                           If Int(Mid(cid, 7, 4)) Mod 4 = 0 And Int(Mid(cid, 7, 4)) Mod 100 <> 0 Then      '如果是能被4整除，且不能被100整除，为闰年
                             rn = True
                           Else
                             rn = False
                           End If
                        End If
                        '取得rn结果
					   If Int(Mid(cid, 11, 2)) = 2 Then                                        '如果是2月，判断天数
						 If rn = True Then   '闰年2月29天
							DaysFebruary = 29
							Else             '否则2月28天
							DaysFebruary = 28
						 End If
						 If Int(Mid(cid, 13, 2)) > DaysFebruary Then         '2月份天数大于DaysFebruary就报错
							CheckID = "Err02_身份证号码错误;"
							Exit Function
						 End If
					   Else                                                                   '如果是其它月份，判断天数
							If Int(Mid(cid, 11, 2)) = 4 Or Int(Mid(cid, 11, 2)) = 6 Or Int(Mid(cid, 11, 2)) = 9 Or Int(Mid(cid, 11, 2)) = 11 Then
							   DaysPerMonth = 30
							Else
							   DaysPerMonth = 31
							End If
						  If Int(Mid(cid, 13, 2)) > DaysPerMonth Then
							CheckID = "Err03_身份证号码错误;"
							Exit Function
						  End If
					  End If

                 '验证检验码
                     Dim cidws
                     Dim s As Long
                     s = 0
                     cidws = Split("7 9 10 5 8 4 2 1 6 3 7 9 10 5 8 4 2", " ")
                     For a = 1 To 17
                     s = s + Mid(cid, a, 1) * cidws(a - 1)
                     Next
                     ys = s Mod 11
                     Dim ysdy, bcid
                     ysdy = Split("1 0 X 9 8 7 6 5 4 3 2", " ")
                     bcid = Left(cid, 17) & ysdy(ys)
                     If bcid <> cid Then
                        CheckID = "Err04_身份证号码校验错误;"
                        Exit Function
                        Else
                        CheckID = ""
                     End If
                End If
        Else
            CheckID = "Err05_身份证号码末位须为半角数字或字母X;"
            Exit Function
        End If
	Else
			CheckID = "Err06_身份证号码前17位须为半角数字;"
			Exit Function
	End If

	Case Else
        CheckID = "Err07_身份证号码必须是18位;"
        Exit Function
    End Select
End Function