身份证号码校验判断VBA函数-适应excel及access

tmtony

先普及一下18位身份证号码各位的含义:
1-2位省、自治区、直辖市代码；
3-4位地级市、盟、自治州代码；
5-6位县、县级市、区代码；
7-14位出生年月日，比如19670401代表1967年4月1日；
15-17位为顺序号，其中17位（倒数第二位）男为单数，女为双数；
18位为校验码，0-9和X。作为尾号的校验码，是由号码编制单位按统一的公式计算出来的，计算的结果是0-10，如果某人的尾号是0－9，都不会出现X，但如果尾号是10，那么就得用X来代替，因为如果用10做尾号，那么此人的身份证就变成了19位。X是罗马数字的10，用X来代替10。

自己以前写的函数一下子找不到了，摘一下网络上搜索到的函数
Function sfzjy(z)
    Dim b As Variant
    a = Len(z)
    b = Right(z, 1)
    If IsNumeric(b) Then
        b = b * 1
    Else: b = "X"
    End If
    C = Left(Right(z, 18), 1) * 1
    d = Left(Right(z, 17), 1) * 1
    e = Left(Right(z, 16), 1) * 1
    f = Left(Right(z, 15), 1) * 1
    g = Left(Right(z, 14), 1) * 1
    h = Left(Right(z, 13), 1) * 1
    i = Left(Right(z, 12), 1) * 1
    j = Left(Right(z, 11), 1) * 1
    k = Left(Right(z, 10), 1) * 1
    l = Left(Right(z, 9), 1) * 1
    m = Left(Right(z, 8), 1) * 1
    n = Left(Right(z, 7), 1) * 1
    o = Left(Right(z, 6), 1) * 1
    p = Left(Right(z, 5), 1) * 1
    q = Left(Right(z, 4), 1) * 1
    r = Left(Right(z, 3), 1) * 1
    s = Left(Right(z, 2), 1) * 1
    u = C * 7 + d * 9 + e * 10 + f * 5 + g * 8 + h * 4 + i * 2 + j * 1 + k * 6 + l * 3 + m * 7 + n * 9 + o * 10 + p * 5 + q * 8 + r * 4 + s * 2
    v = u Mod 11
     If a = 0 Then sfzjy = "空": GoTo 100
    If a = 15 Then sfzjy = "老号，请认真核对！": GoTo 100
        If a = 18 Then
        If v = 0 And b = 1 Then sfzjy = "正确": GoTo 100
        If v = 1 And b = 0 Then sfzjy = "正确": GoTo 100
        If v = 2 And b = "X" Then sfzjy = "正确": GoTo 100
        If v = 3 And b = 9 Then sfzjy = "正确": GoTo 100
        If v = 4 And b = 8 Then sfzjy = "正确": GoTo 100
        If v = 5 And b = 7 Then sfzjy = "正确": GoTo 100
        If v = 6 And b = 6 Then sfzjy = "正确": GoTo 100
        If v = 7 And b = 5 Then sfzjy = "正确": GoTo 100
        If v = 8 And b = 4 Then sfzjy = "正确": GoTo 100
        If v = 9 And b = 3 Then sfzjy = "正确": GoTo 100
        If v = 10 And b = 2 Then sfzjy = "正确": GoTo 100
        End If
        If (sfzjy <> "正确") And (sfzjy <> "老号") And (sfzjy <> "空") And (sfzjy <> "位数不对") Then sfzjy = "出错啦"
100:
End Function

WFH6898

高手啊

roych

风中漫步 发表于 2015-11-12 10:09
有点复杂了!
期待个简单的.

红尘的例子。
http://www.office-cn.net/thread-92995-1-1.html
很久之前拿andymark的修改过的例子。
http://www.office-cn.net/thread-109857-1-1.html

风中漫步

有点复杂了!
期待个简单的.

josam

msgbox "赞'