近几日，我的工作是录入更正的农业直补农户资料，涉及到了各包村干部上报的各种样式的报表，经会计清点后，由我来统一按上报的格式来摘抄到上报表中。据会计说，我的字写得还过得去，比小代强。
我建议用计算机来处理，打字比写字可快多了，还清楚。
下面的工作，就是录入一大堆的编号和身份证号以及姓名。姓名不是难事，在录入几十个后，我越发的想去上网，把读霸安装上，我打它来读，这样就不用抬头看屏幕了。想到乡里网吧的半个小时打开一封邮件的速度呀，我还是放弃了。
身份证可是不能再错误了，幸好我的电子书里有一段关于身份证格式的说明和程序，在稍加修改后，它已经可以用来批量的判断身份证是不是有格式（包括长度，出生年月，验证位）的错误。
本想通过数据有效性来作，只是公式里不能调用VBA的函数，真是郁闷。
下次有机会，改写一个公式来判断的。
Sub 检验选定区域身份证()
'
' 检验身份证 Macro
' 用于检测身份证号码是否正确
'
' 快捷键: Ctrl+q
'
Dim arange As range
Dim acell As range
Dim ret As Integer
Set arange = Selection
For Each acell In arange.Cells
'MsgBox ActiveCell.Text
ret = IDCheck(UCase(acell.Text))
If ret <> 0 Then
acell.Select
MsgBox "请检查当前选定单元格的身份证是否正确", , "提示"
Exit Sub
End If
Next
MsgBox "全部正确", , "提示"
End Sub
Function CurrentIdCheck() As Integer
Dim ret As Integer
'MsgBox ActiveCell.Text
'ret = IDCheck(ActiveCell.Text)
'MsgBox ret
'CurrentIdCheck = ret
CurrentIdCheck = 0
End Function
Function IDCheck(ByVal e As String) As Integer
Dim arrVerifyCode
Dim Wi
Dim Checker
Dim BirthDay
IDCheck = 0 '验证通过时返回
arrVerifyCode = Split("1,0,X,9,8,7,6,5,4,3,2", ",")
Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",")
Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",")
If Len(e) < 15 Or Len(e) = 16 Or Len(e) = 17 Or Len(e) > 18 Then
'IDCheck= "身份证号必须是15位数或18位数！"
IDCheck = 1
Exit Function
End If
Dim Ai As String
If Len(e) = 18 Then
Ai = Mid(e, 1, 17)
ElseIf Len(e) = 15 Then
Ai = CStr(e)
Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9)
End If
If Not IsNumeric(Ai) Then
'IDCheck= "身份证除最后一位外，必须为数字！"
IDCheck = 2
Exit Function
End If
Dim strYear As Integer
Dim strMonth As Integer
Dim strDay As Integer
strYear = CInt(Mid(Ai, 7, 4))
strMonth = CInt(Mid(Ai, 11, 2))
strDay = CInt(Mid(Ai, 13, 2))
BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)
If IsDate(BirthDay) Then
If DateDiff("yyyy", Now(), CDate(BirthDay)) < -140 Or CDate(BirthDay) > Now() Then
'IDCheck= "身份证输入错误（日期输入错误）！"
IDCheck = 3
Exit Function
End If
If strMonth > 12 Or strDay > 31 Then
'IDCheck= "身份证输入错误（日期输入错误）！"
IDCheck = 3
Exit Function
End If
Else
'IDCheck= "身份证输入错误（日期输入错误）！"
IDCheck = 3
Exit Function
End If
Dim i As Integer
Dim TotalmulAiWi As Integer
For i = 0 To 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * CInt(Wi(i))
Next
Dim modValue As Integer
modValue = TotalmulAiWi Mod 11
Dim strVerifyCode ' As Object
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
If Len(e) = 18 And CStr(e) <> Ai Then
'IDCheck= "身份证号码输入错误（身份证包含有非法字符）！"
IDCheck = 4
Exit Function
End If
End Function