自己以前写的函数一下子找不到了，摘一下网络上搜索到的函数
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