excel vba 身份证校验

身份证18位分别代表的含义，身份证15位升级到18位，原来年用2位且没有最后一位，从左到右方分别表示
①1-2 升级行政区代码
②3-4 地级行政区划分代码
③5-6 县区行政区分代码
④7-10 11-12 13-14 出生年、月、日
⑤15-17 顺序码，同一地区同年、同月、同日出生人的编号，奇数是男性，偶数是女性
⑥18 校验码，如果是0-9则用0-9表示，如果是10则用X（罗马数字10）表示
身份证号码编码规则及校验位校验算法

Function isValidPersionID(sfz As String) As Boolean  Dim yy As Integer  Dim mm As Integer  Dim dd As Integer  Dim i As Integer  Dim iPidLen As Integer  Dim arPidWeight  Dim arPidCheck  Dim lCheckSum As Long  isValidPersionID = False  iPidLen = Len(sfz)  If iPidLen <> 18 And iPidLen <> 15     Then      this.Text = "#VALUE!" '在表格中写入#VALUE!，以下部分都可以参照       Exit Function  End If  arPidWeight = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)'权重  arPidCheck = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")'所有值    lCheckSum = 0    For i = 1 To 15If InStr("0123456789", Mid(sfz, i, 1)) = 0 Then Exit Function        lCheckSum = lCheckSum + CInt(Mid(sfz, i, 1)) * arPidWeight(i - 1)    Next i    If iPidLen = 15     Then       yy = CInt(Mid(sfz, 7, 2)) + 1900       mm = CInt(Mid(sfz, 9, 2))       dd = CInt(Mid(sfz, 11, 2))     Else   yy = CInt(Mid(sfz, 7, 4))   mm = CInt(Mid(sfz, 11, 2))   dd = CInt(Mid(sfz, 13, 2))Then Exit Function   If InStr("0123456789", Mid(sfz, 17, 1)) = 0    Then Exit Function   If InStr("0123456789X", UCase(Mid(sfz, 18, 1))) = 0'转成大写字母    Then Exit FunctionlCheckSum = lCheckSum + CInt(Mid(sfz, 16, 1)) * arPidWeight(15)    lCheckSum = lCheckSum + CInt(Mid(sfz, 17, 1)) * arPidWeight(16)    lCheckSum = lCheckSum Mod 11   If UCase(Mid(sfz, 18, 1)) <> arPidCheck(lCheckSum)'转成大写字母      Then Exit Function    End If    If Not isValidDate(yy, mm, dd)        Then Exit Function    isValidPersionID = True End FunctionFunction isValidDate(yy As Integer, mm As Integer, dd As Integer) As Boolean    isValidDate = False    If yy > 2200 Or yy < 1900         Then Exit Function    If mm > 12 Or mm < 1         Then Exit Function    If dd < 1         Then Exit Function    If (mm = 1 Or mm = 3 Or mm = 5 Or mm = 7 Or mm = 8 Or mm = 10 Or mm = 12) And dd > 31         Then Exit Function    If (mm = 4 Or mm = 6 Or mm = 9 Or mm = 11) And dd > 30          Then Exit Function    If yy Mod 4 = 0 Then        If mm = 2 And dd > 29         Then Exit Function    Else        If mm = 2 And dd > 28             Then Exit Function    End If    isValidDate = TrueEnd Function