各位朋友，你們好。今天和你們分享身份證信息的自定義函數。

身份證号碼在生活和工作中使用非常廣泛，因此在日常工作中經常會需要對身份證号碼進行分析和處理。今天給大家介紹對身份證信息處理的兩個自定義函數。

①、身份證号碼正誤檢查；

②、從身份證号中提取信息。

身份證号碼在很多地方都需要用到，如果我們在登記身份信息時，錄入了錯誤的身份證号碼，會給我們帶來很多不必要的麻煩。因此，在錄入身份的時候，最好能對身份證号正誤進行檢查，下面就給大家說說從哪些方面對身份證号進行檢查。（以下代碼中【ID】作為一個字符串變量，表示身份證号碼）

1、身份證号碼位數檢查

現在身份證号碼都是18位的，如果少錄入了一位，憑一雙肉眼還真不一定能及時發現。我們可以用以下代碼來檢查身份證号碼的位數：

If VBA.Len(ID) <> 18 Then CheckID = "身份證号碼位數錯誤" Exit Function End If

2、檢查非法字符

身份證号碼前17位均為數字，如果不小心錄入成了字母，會造成号碼錯誤，所以需要對其做判斷，代碼如下：

For a = 1 To 17 If VBA.IsNumeric(VBA.Mid(ID, a, 1)) = False Then CheckID = "身份證号有非法字符" Exit Function End If Next

3、省份地址代碼檢查

身份證号碼的前面六位是表示省市縣信息的地址代碼，這個代碼錯誤必然會導緻身份證号碼錯誤，所以需要檢查，代碼如下：

Dim SFCode '省份代碼存放數組 Set Dic = CreateObject("scripting.dictionary") SFCode = Array(11, 12, 13, 14, 15, 21, 22, 23, 31, 32, 33, 34, 35, 36, 37, 41, 42, 43, 44, 45, 46, 50, 51, 52, 53, 54, 61, 62, 63, 64, 65, 71, 81, 92, 91) For a = 1 To UBound(SFCode, 1) Dic(SFCode(a - 1)) = "" Next If Not Dic.exists(VBA.Left(ID, 2) * 1) Then CheckID = "區域代碼錯誤" Exit Function End If

由于無法單獨對市和縣地址代碼單獨核查，市和縣的地址信息必須與省份地址信息結合來做判斷，這樣就需要一份數據表，有條件的朋友可以收集一份完整、詳細的地址代碼信息表。

4、生日信息檢查

身份證号碼中有生日信息，這個生日信息，也可以作為檢查身份證号碼是否正确的一個參數，代碼如下：

DimDateCode$ DateCode = Application.Text(VBA.Mid(ID, 7, 8), "0000-00-00") If VBA.IsDate(DateCode) = False Then CheckID = "生日信息錯誤" Exit Function End If

5、身份校驗碼檢查

這個是身份證号碼檢查比較重要的一個參數，前面的位數、非法字符、生日等信息，細心點或許可以檢查處理，而身份證校驗碼，需要通過一定的計算過程才能算出，這個校驗碼也是15位身份證号碼升級18位身份證号碼的一個關鍵點。

對身份證校驗碼的判斷，需要先根據計算出校驗碼，然後再和所錄入的校驗碼對比看是否一緻。代碼如下：

Dim ArrayCode, ArrayMod, ArrayCoef '身份證驗算代碼存放數組 Dim ResultProd, ValidateCode$, ArrayID(16) As Integer ArrayCode = Array(1, 0, "X", 9, 8, 7, 6, 5, 4, 3, 2) ArrayMod = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10) ArrayCoef = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2) For a = 1 To 17 ArrayID(a - 1) = VBA.Mid(ID, a, 1) Next ResultProd = Application.WorksheetFunction.SumProduct(ArrayCoef, ArrayID) ResultMod = ResultProd Mod 11 ValidateCode = Application.WorksheetFunction.Index(ArrayCode, ResultMod 1) If ValidateCode <> Right(ID, 1) Then CheckID = "身份證校驗碼錯誤" Else CheckID = "正确" End If

6、合并成一個自定義函數

最後，将以上的代碼全部合并起來，就可以得到一個完整的身份證号碼信息檢查的自定義函數；

Function CheckID(ID As String) '檢驗身份證号碼是否正确的自定義函數 Dim SFCode '省份代碼存放數組 Dim ArrayCode, ArrayMod, ArrayCoef '身份證驗算代碼存放數組 Dim ResultProd, ValidateCode$, DateCode$, ArrayID(16) As Integer Dim Dic Dim a As Byte Set Dic = CreateObject("scripting.dictionary") SFCode = Array(11, 12, 13, 14, 15, 21, 22, 23, 31, 32, 33, 34, 35, 36, 37, 41, 42, 43, 44, 45, 46, 50, 51, 52, 53, 54, 61, 62, 63, 64, 65, 71, 81, 92, 91) ArrayCode = Array(1, 0, "X", 9, 8, 7, 6, 5, 4, 3, 2) ArrayMod = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10) ArrayCoef = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2) '身份證位數檢查 If VBA.Len(ID) <> 18 Then CheckID = "身份證号碼位數錯誤" Exit Function End If '前17位隻能是數字 For a = 1 To 17 If VBA.IsNumeric(VBA.Mid(ID, a, 1)) = False Then CheckID = "身份證号有非法字符" Exit Function End If Next '省市代碼檢查 For a = 1 To UBound(SFCode, 1) Dic(SFCode(a - 1)) = "" Next If Not Dic.exists(VBA.Left(ID, 2) * 1) Then CheckID = "區域代碼錯誤" Exit Function End If '生日信息檢查 DateCode = Application.Text(VBA.Mid(ID, 7, 8), "0000-00-00") If VBA.IsDate(DateCode) = False Then CheckID = "生日信息錯誤" Exit Function End If '身份證校驗碼驗證 For a = 1 To 17 ArrayID(a - 1) = VBA.Mid(ID, a, 1) Next ResultProd = Application.WorksheetFunction.SumProduct(ArrayCoef, ArrayID) ResultMod = ResultProd Mod 11 ValidateCode = Application.WorksheetFunction.Index(ArrayCode, ResultMod 1) If ValidateCode <> Right(ID, 1) Then CheckID = "身份證校驗碼錯誤" Else CheckID = "正确" End If End Function

從身份證号碼中，我們可以提取生日、性别，然後可以利用生日計算出年齡。

當然還可以利用生日信息計算星座、農曆生日。但是每年的星座日期都不是完全固定的，會出現一定概率的錯誤；對農曆生日的計算，還需要其他的自定義函數，超出了本次知識點的範圍了；省市縣地址代碼的信息，也和身份證上的地址信息不會完全一緻，除了計算籍貫，其他用處不太大。所以本次機僅考慮提取生日、性别、年齡這三個信息。

下面是自定義函數的代碼，這個自定義函數有兩個參數，一個是身份證号碼，一個是提取類型參數。提取類型為1，可以得到性别；提取類型為2，可以得到年齡；提取類型為3，可以得到年齡。

Public Function GetID(ID As String, LookupType As Byte) '從身份證号碼中提取信息的自定義函數 Dim a%, Tmp$ '申明變量 Application.Volatile Tmp = Trim(ID) Select Case LookupType Case 1 'Sex Dim SexValue As Byte SexValue = VBA.Mid(Tmp, 17, 1) If SexValue Mod 2 = 1 Then GetID = "男" Else GetID = "女" End If Case 2 'Birthday GetID = Application.Text(VBA.Mid(Tmp, 7, 8), "0000-00-00") Case 3 'Age Dim DateCode As String DateCode = Application.Text(VBA.Mid(Tmp, 7, 8), "0000-00-00") GetID = DateDiff("yyyy", DateCode, Now) End Select End Function

更多精彩资讯请关注tft每日頭條，我们将持续为您更新最新资讯!