求Excel函数的问题我今天制作
非要使用公式的话，可以试一下ExcelHome上一位达人写的这个公式，个人感觉精练多了：
=IF(LEN(A2)=15,REPLACE(A2,7,,19)&MID("10X98765432",MOD(SUMPRODUCT(MID(REPLACE(A2,7,,19),ROW(INDIRECT("1:17")),1)*2^(18-ROW(INDIRECT("1:17")))),11)+1,1),A2)
用我做的自定义函数吧：
首先，按“Alt+F11”进入VBE；
然后，点菜单“插入”－》“模块”；
接着，复制如下代码至右侧编辑窗口：
Option Explicit
Function Chec...全部
非要使用公式的话，可以试一下ExcelHome上一位达人写的这个公式，个人感觉精练多了：
=IF(LEN(A2)=15,REPLACE(A2,7,,19)&MID("10X98765432",MOD(SUMPRODUCT(MID(REPLACE(A2,7,,19),ROW(INDIRECT("1:17")),1)*2^(18-ROW(INDIRECT("1:17")))),11)+1,1),A2)
用我做的自定义函数吧：
首先，按“Alt+F11”进入VBE；
然后，点菜单“插入”－》“模块”；
接着，复制如下代码至右侧编辑窗口：
Option Explicit
Function CheckID(IdStr) As String '身份证号码校验
On Error GoTo ErrorHandle '设置错误处理
Application。
Volatile (False) '将函数标记为非易失性函数
Dim wi As Variant, ji As Variant, sum%, i%, intMsg%, datBirthday As Date
wi = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)
ji = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")
If Len(IdStr) = 15 Then
If Not IsNumeric(IdStr) Then
Err。
Raise vbObjectError + 1000, , "号码中有非法字符"
End If
IdStr = Left(IdStr, 6) & "19" & Right(IdStr, 9)
ElseIf Len(IdStr) = 18 Then
If Not (IsNumeric(Mid(IdStr, 1, 17)) And (IsNumeric(Right(IdStr, 1)) Or Right(IdStr, 1) = "X" Or Right(IdStr, 1) = "x")) Then
Err。
Raise vbObjectError + 1001, , "号码中有非法字符"
End If
ElseIf Len(IdStr) = 0 Then
Exit Function
Else
Err。
Raise vbObjectError + 1002, , "号码不是15位或18位"
End If
datBirthday = DateValue(Mid(IdStr, 7, 4) & "-" & Mid(IdStr, 11, 2) & "-" & Mid(IdStr, 13, 2))
sum = 0
For i = 0 To UBound(wi)
sum = sum + Mid(IdStr, i + 1, 1) * wi(i)
Next i
If Len(IdStr) = 17 Then
CheckID = IdStr & ji(sum Mod 11) '将15位的身份证转化成18位的号码
'CheckID = Left(IdStr, 6) & Right(IdStr, 9) '不对15位的号码升位
Else
If ji(sum Mod 11) <> Right(IdStr, 1) Then
intMsg = MsgBox("18位身份证号码中的校验码错误！" & vbCrLf & "您要输入的是：" & Left(IdStr, 17) & ji(sum Mod 11) & "吗？", vbYesNo)
If intMsg = vbYes Then
CheckID = Left(IdStr, 17) & ji(sum Mod 11)
Else
Err。
Raise vbObjectError + 1003, , "末位校验码有误"
End If
Else
CheckID = IdStr
End If
End If
Exit Function
ErrorHandle:
If Err。
Number = 13 Then
CheckID = "号码中出生日期非法"
Else
CheckID = Err。
Description
End If
Exit Function
End Function
然后在文件中像使用普通函数一样调用这个函数就可以了，具体语法为：
A B
1 320924831102412 =CheckID(A1)
详见附件：。收起
