• 在Excel中检验身份证号


      近几日,我的工作是录入更正的农业直补农户资料,涉及到了各包村干部上报的各种样式的报表,经会计清点后,由我来统一按上报的格式来摘抄到上报表中。据会计说,我的字写得还过得去,比小代强。
      我建议用计算机来处理,打字比写字可快多了,还清楚。
      下面的工作,就是录入一大堆的编号和身份证号以及姓名。姓名不是难事,在录入几十个后,我越发的想去上网,把读霸安装上,我打它来读,这样就不用抬头看屏幕了。想到乡里网吧的半个小时打开一封邮件的速度呀,我还是放弃了。
      身份证可是不能再错误了,幸好我的电子书里有一段关于身份证格式的说明和程序,在稍加修改后,它已经可以用来批量的判断身份证是不是有格式(包括长度,出生年月,验证位)的错误。
      本想通过数据有效性来作,只是公式里不能调用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 StringAs 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, 117)
     
    ElseIf Len(e) = 15 Then
     Ai 
    = CStr(e)
     Ai 
    = Left(Ai, 6& "19" & Mid(Ai, 79)
     
    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, 74))
     strMonth 
    = CInt(Mid(Ai, 112))
     strDay 
    = CInt(Mid(Ai, 132))
     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 + 11)) * 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
  • 相关阅读:
    python之openpyxl模块(最全总结 足够初次使用)
    随笔 遇见
    浅析企业服务器安全防护的七个切入点
    jQuery.API源码深入剖析以及应用实现(1) - 核心函数篇
    常用Javascript精选(二)
    随笔 生活与生命
    jquery插件 8个很有用的jQuery插件
    jquery插件 5个小插件
    常用Javascript精选(一)
    jQuery库与其他JS库冲突的解决办法(转)
  • 原文地址:https://www.cnblogs.com/evlon/p/1195113.html
Copyright © 2020-2023  润新知