同學們在用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位是否在區劃代碼中找到。
代碼如下：
<code>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/<code>2.身份證的長度驗證
身份證字符長度應為18位或15位，其他長度的不符合要求
<code>If Not (Len(MyId) = 18 Or Len(MyId) = 15) Then
IdCardCheck = "身份信息位數不符合要求"
Exit Function
End If/<code>
3.驗證日期字符串是否合法
（1）驗證身份證信息中除最後一位是否含有字符，如果含有字符，說明不合法；
（2）驗證日期格式是否合法。如“20001232”則不合法。由於15位身份證格式為YYMMDD格式，先補齊為YYYYMMDD格式，如“550708”補齊為“19550708”
<code>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/<code>
4.驗證校驗碼
身份證號碼中各個位置上的號碼字符值應滿足下列公式的校驗：
- i表示號碼字符從右至左包括校驗碼字符在內的位置序號；
- ai表示第i位置上的號碼字符值；
- Wi表示第i位置上的加權因子，加權因子計算公式：
舉個例子：
代碼如下：
<code>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/<code>
以上就是一個身份證校驗的完整過程，有什麼錯誤歡迎討論，部分內容來源於網絡。
附完整代碼如下：
<code>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位（區劃代碼）驗證————————————
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))
If MyDate < 1 Or MyDate > Date Then
IdCardCheck = "日期錯誤"
Exit Function
End If
第四步: '—————————— 校驗碼的生成檢查————————————
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
IdCardCheck = MyId
End Function/<code>
參考文章:
1. 《身份證號碼的編碼規則及校驗》作者：godson_ds
2. ISO 7064:1983.MOD11-2校驗碼計算法
閱讀更多 水母筆記 的文章
