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 15
If 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 Function
lCheckSum = 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 Function

Function 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 = True
End Function