身份证号码全最新攻略--VBA应用

18 位身份证号码编码规则：根据〖中华人民共和国国家标准 GB 11643-1999〗中有关公民身份号码的规定，公民身份号码是特征组合码，由十七位数字本体码和一位数字或字符（X）校验码组成。排列顺序从左至右依次为：六位地址码，八位出生日期码，三位顺序码和一位校验码。

请看示例：

6位地址码中，前2位表示省、直辖市、自治区：

11-15  京、津、冀、晋、蒙 

21-23  辽、吉、黑 

31-37  沪、苏、浙、皖、闽、赣、鲁 

41-46  豫、鄂、湘、粤、桂、琼 

50-54  渝、川、贵、云、藏 

61-65  陕、甘、青、宁、新

后4位表示市、县、区。

请看示例：

8位出生日期码采用8位定长日期表示法：4位年、2位月、2位日。

3位顺序码表示同一日出生的次序和性别，奇数代表男性，偶数代表女性。

最后1位校验码用“0-9”和“X”表示。

校验码是通过数学计算得出来的。

    校验码计算公式：（12-∑(Ai×Wi)(mod 11)）mod 11

i—表示身份证号码从左至右的位置序号，取值1--17； 

Ai—表示第i位上的数字； 

Wi—表示第i位上的加权因子。

    加权因子计算公式：Wi=2^(i-1)(mod 11)

校验码计算结果为“0--10”11个数字之一，其中“10”用“X”表示。 

后面的内容要用到VBA编程的一些知识。跟我一起来了解一下VBA怎么使用吧，很简单的！

1. 新建并打开一个excel文档

2. 右击工作表标签-->查看代码

3. 在代码窗口中输入程序

4. 按下F5执行程序

这里有一些待验证的身份证号码，接下来要编程验证其真伪，并提取所包含的信息。需要您做的是：通过下面这个链接下载“身份证号码攻略”，这是一个excel文档，里面有编好的程序，把您需要验证的身份证号码填进去，运行程序即可。

下载链接：http://pan.baidu.com/s/1gd3qTbX

这是程序代码，里面有详细说明，这里就不赘述了。

Sub IDcheck() '验证身份证号码有效性并提取所包含的信息

Application.ScreenUpdating = False

Dim IDcode As String            '用于存放身份证号码的变量

Dim EndRow1, EndRow2 As Single  '两个工作表最后一行行号的变量

Dim CheckCode As Variant        '用于存放校验码的变量

Dim sAdr As String              '用于存放原始发证地址的变量

EndRow1 = Sheets(1).Range("a65535").End(xlUp).Row

EndRow2 = Sheets(2).Range("a65535").End(xlUp).Row

If EndRow1 < 2 Then Exit Sub

For i = 2 To EndRow1            '遍历表中所有身份证号码

   '初始化

   IDcode = Sheets(1).Cells(i, 1)

   Sheets(1).Range("b" & i & ":e" & i) = ""

   '在行政区划代码数据库（Sheets(2)）中查找前六位地址代码是否存在，f=1表示存在。将以此为依据判断地址代码的有效性！

   f = 0

   For j = 1 To EndRow2

      If Sheets(2).Cells(j, 2) & " " = Left(IDcode, 6) & " " Then

         f = 1

         sAdr = Sheets(2).Cells(j, 3) '前六位对应的原始发证地址

         Exit For

      End If

   Next j

   '对身份证号码的有效性进行判别！

   If Len(IDcode) <> 18 Then

      Sheets(1).Cells(i, 2) = "位数不正确—" & Chr(10) & "18位才对！"

   ElseIf Not IsNumeric(Left(IDcode, 17)) Or Not IsNumeric(Right(IDcode, 1)) And Right(IDcode, 1) <> "x" And Right(IDcode, 1) <> "X" Then

      Sheets(1).Cells(i, 2) = "格式不正确—" & Chr(10) & "前17位为数字，最后一位为数字或“x”"

   ElseIf f = 0 Then

      Sheets(1).Cells(i, 2) = "地址代码不正确—" & Chr(10) & "该地区暂不适合人类居住！"

   ElseIf Not IsDate(Mid(IDcode, 7, 4) & "-" & Mid(IDcode, 11, 2) & "-" & Mid(IDcode, 13, 2)) Then

      Sheets(1).Cells(i, 2) = "表示出生日期的号码不正确—" & Mid(IDcode, 7, 8) & Chr(10) & "疑似火星日历！"

   ElseIf Val(Mid(IDcode, 7, 4)) > Year(Date) Then

      Sheets(1).Cells(i, 2) = "表示出生日期的号码不正确—" & Chr(10) & "此人尚未出生！"

   ElseIf Year(Date) - Val(Mid(IDcode, 7, 4)) > 120 Then

      Sheets(1).Cells(i, 2) = "表示出生日期的号码不正确—" & Chr(10) & "此人已亡故！"

   Else

      '判别最后一位校验码是否正确

      CheckCode = 0

      For j = 1 To 17

         CheckCode = CheckCode + Val(Mid(IDcode, j, 1)) * 2 ^ (19 - j - 1) Mod 11

      Next j

      CheckCode = 12 - CheckCode Mod 11

      If CheckCode = 10 Then

         CheckCode = "X"

      ElseIf CheckCode > 10 Then

         CheckCode = CheckCode - 11

      End If

      If CheckCode & " " <> Right(IDcode, 1) & " " Then

         Sheets(1).Cells(i, 2) = "校验码不正确！"

      Else

         Sheets(1).Cells(i, 2) = "有效！"

          '提取身份证号码所包含的信息

         Sheets(1).Cells(i, 3) = sAdr

         Sheets(1).Cells(i, 4) = Mid(IDcode, 7, 4) & "-" & Mid(IDcode, 11, 2) & "-" & Mid(IDcode, 13, 2)

         If Val(Mid(IDcode, 15, 3)) Mod 2 = 1 Then

              Sheets(1).Cells(i, 5) = "男"

         Else

              Sheets(1).Cells(i, 5) = "女"

         End If

      End If

   End If

Next i

Application.ScreenUpdating = True

End Sub

这是验证结果

下面是随机生成身份证号码的程序代码：

Sub IDcreat() '随机生成一个身份证号码

    Dim IDcode As String  '定义变量，用于存放18位身份证号码

    Dim Adco As String    '定义变量，用于存放6位地址码

    Dim Bico As String    '定义变量，用于存放8位出生日期

    Dim Seco As String    '定义变量，用于存放3位性别码

    Dim Chco As Variant   '定义变量，用于存放1位校验码

    EndRow2 = Sheets(2).Range("a65535").End(xlUp).Row  '行政区划代码数据库（sheets2）最后一行行号

    Adco = Sheets(2).Cells(Int(Rnd * EndRow2) + 1, 2)  '随机获取地址码

    Bico = Format(#1/1/1900# + Int(Rnd * (Date - #1/1/1900# + 1)), "yyyymmdd") '随机生成出生日期

    Seco = Format(1 + Int(Rnd * 995), "000")  '随机生成性别码

    IDcode = Adco & Bico & Seco  '生成前17位号码

    '求校验码（还有更精炼的方法，此例以易读为先。）

    Chco = 0

    For i = 1 To 17

       Chco = Chco + Val(Mid(IDcode, i, 1)) * 2 ^ (19 - i - 1) Mod 11

    Next i

    Chco = 12 - Chco Mod 11

    If Chco = 10 Then

       Chco = "X"

    ElseIf Chco > 10 Then

       Chco = Chco - 11

    End If

    '完工

    IDcode = IDcode & Chco

    Sheets(1).Cells(20, 1) = IDcode

    Sheets(1).Range("b20:e20") = ""

    '验证一下

    Call Sheets(1).IDcheck

End Sub

首先需要定义一些变量：

    Dim IDcode As String  '定义变量，用于存放18位身份证号码

    Dim Adco As String    '定义变量，用于存放6位地址码

    Dim Bico As String    '定义变量，用于存放8位出生日期

    Dim Seco As String    '定义变量，用于存放3位性别码

    Dim Chco As Variant   '定义变量，用于存放1位校验码

以下代码生成身份证号码的前17位：

    EndRow2 = Sheets(2).Range("a65535").End(xlUp).Row  '行政区划代码数据库（sheets2）最后一行行号

    Adco = Sheets(2).Cells(Int(Rnd * EndRow2) + 1, 2)  '随机获取地址码

    Bico = Format(#1/1/1900# + Int(Rnd * (Date - #1/1/1900# + 1)), "yyyymmdd") '随机生成出生日期

    Seco = Format(1 + Int(Rnd * 995), "000")  '随机生成性别码    

    IDcode = Adco & Bico & Seco  '组装前17位身份证号码

以下代码计算最后一位验证码：

    Chco = 0

    For i = 1 To 17

       Chco = Chco + Val(Mid(IDcode, i, 1)) * 2 ^ (19 - i - 1) Mod 11

    Next i

    Chco = 12 - Chco Mod 11

    If Chco = 10 Then

       Chco = "X"

    ElseIf Chco > 10 Then

       Chco = Chco - 11

    End If

 把验证码也组装进去----完工： 

   IDcode = IDcode & Chco