用VBA构建身份证验证函数
同学们在用VBA构建用户管理系统时，需要收集用户信息，在采集用户信息时，经常会遇到身份证信息输入混乱的情况，有的用户胡乱输入、有的输入明显错误，如何对身份证信息进行校验，规范输入信息呢？本节深入探讨用VBA代码进行身份证校验。
身份证号码的编码规则
身份证号码共18位，由17位本体码和1位校验码组成。范仲淹岳阳楼记
1. 前6位是地址码，表示登记户口时所在地的行政区划代码，依照《中华人民共和国行政区划代码》国家标准（GB/T2260）的规定执行；
2. 7到14位是出生年月日，采用YYYYMMDD格式；
3. 15到17位是顺序码，表示在同一地址码所标识的区域范围内，对同年、同月、同日出生的人编订的顺序号，顺序码的奇数分配给男性，偶数分配给女性，即第17位奇数表示男性，偶数表示女性；
4. 第18位是校验码，采用ISO 7064:1983, MOD 11-2校验字符系统。
一代身份证与二代身份证的区别在于：
1. 一代身份证是15位，二代身份证是18位；
2. 一代身份证出生年月日采用YYMMDD格式，二代身份证出生年月日采用YYYYMMDD格式；
3. 一代身份证无校验码，二代身份证有校验码。

1.区划代码校验
首先，把从网上下载的行政区划代码放入名为“区划代码”的工作表中，此步骤主要是校验用户输入的前6位是否在区划代码中到。
代码如下：
arr = Worksheets("区划代码").Range("a1", Worksheets("区划代码").Range("a" & Rows.Count).End(xlUp))
    AreaCode = Mid(MyId, 1, 6) '提取身份证前6位
    IsCorrect = False
    For i = 1 To UBound(arr)入党动机范文
       
        If CStr(arr(i, 1)) = AreaCode Then
            IsCorrect = True
            Exit For
        End If
    Next
    If IsCorrect = False Then
        IdCardCheck = "区划代码错误"
        Exit Function
    End If
2.身份证的长度验证
身份证字符长度应为18位或15位，其他长度的不符合要求
If Not (Len(MyId) = 18 Or Len(MyId) = 15) Then
        IdCardCheck = "身份信息位数不符合要求"
        Exit Function
    End If
3.验证日期字符串是否合法
（1）验证身份证信息中除最后一位是否含有字符，如果含有字符，说明不合法；
（2）验证日期格式是否合法。如“20001232”则不合法。由于15位身份证格式为YYMMDD格式，先补齐为YYYYMMDD格式，如“550708”补齐为“19550708”
If Len(MyId) = 15 Then MyId = Left(MyId, 6) & "19" & Right(MyId, 9)
    If IsNumeric(Left(MyId, 17)) = False Or InStr(MyId, ".") > 0 Then '字符检验
        IdCardCheck = "字符错误"
        Exit Function
    End If
    On Error Resume Next '日期检验
    MyDate = DateValue(Mid(MyId, 7, 4) & "-" & Mid(MyId, 11, 2) & "-" & Mid(MyId, 13, 2))
    If MyDate < 1 Or MyDate > Date Then
      IdCardCheck = "日期错误"
      Exit Function
    End If
4.验证校验码
身份证号码中各个位置上的号码字符值应满足下列公式的校验：
   
●i表示号码字符从右至左包括校验码字符在内的位置序号；
●ai表示第i位置上的号码字符值；
●Wi表示第i位置上的加权因子，加权因子计算公式：
健康饮食知识问答举个例子：
1升等于多少克
代码如下：
If Len(MyId) = 18 Then
        sum = 0
        For i = 1 To 17
          sum = sum + Val(Mid(MyId, 18 - i, 1)) * (2 ^ i Mod 11)
        Next
        If Mid(MyId, 18, 1) = "X" Then
            sum = sum + 10
        Else
            sum = sum + Val(Mid(MyId, 18, 1)) * 1
        End If
        If sum Mod 11 <> 1 Then
            IdCardCheck = "校验码错误"
            Exit Function
        End If
End If
以上就是一个身份证校验的完整过程，有什么错误欢迎讨论，部分内容来源于网络。
附完整代码如下：
Function IdCardCheck(IdString)
    Dim arr, AreaCode As String, i As Long, IsCorrect As Boolean
    Dim MyDate As Date, MyId As String, sum As Long
    MyId = CStr(IdString)
第一步:  '—————————— 身份证号码前6位（区划代码）验证————————————
   
qq心悦会员    arr = Worksheets("区划代码").Range("a1", Worksheets("区划代码").Range("a" & Rows.Count).End(xlUp))
    AreaCode = Mid(MyId, 1, 6) '提取身份证前6位
    IsCorrect = False
陈一冰老婆    For i = 1 To UBound(arr)
       
        If CStr(arr(i, 1)) = AreaCode Then
            IsCorrect = True
            Exit For
        End If
    Next
    If IsCorrect = False Then
        IdCardCheck = "区划代码错误"
        Exit Function
    End If
   
第二步:  '—————————— 验证身份证长度是否合法————————————
    If Not (Len(MyId) = 18 Or Len(MyId) = 15) Then
        IdCardCheck = "身份信息位数不符合要求"
        Exit Function
    End If
   
第三步:  '—————————— 验证日期字符串否合法————————————
    If Len(MyId) = 15 Then MyId = Left(MyId, 6) & "19" & Right(MyId, 9)
    If IsNumeric(Left(MyId, 17)) = False Or InStr(MyId, ".") > 0 Then '字符检验
        IdCardCheck = "字符错误"
        Exit Function
    End If
    On Error Resume Next '日期检验
    MyDate = DateValue(Mid(MyId, 7, 4) & "-" & Mid(MyId, 11, 2) & "-" & Mid(MyId, 13, 2))