身份证自定义函数是什么意思（关于身份证信息的自定义函数）

各位朋友，你们好。今天和你们分享身份证信息的自定义函数。

身份证号码在生活和工作中使用非常广泛，因此在日常工作中经常会需要对身份证号码进行分析和处理。今天给大家介绍对身份证信息处理的两个自定义函数。

①、身份证号码正误检查；

②、从身份证号中提取信息。

身份证号码在很多地方都需要用到，如果我们在登记身份信息时，录入了错误的身份证号码，会给我们带来很多不必要的麻烦。因此，在录入身份的时候，最好能对身份证号正误进行检查，下面就给大家说说从哪些方面对身份证号进行检查。（以下代码中【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