ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 Office知识技巧免费学 打造核心竞争力的职场宝典
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 299|回复: 7

[求助] VBA 小程序问题 身份证性别识别

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-12-5 16:50 | 显示全部楼层 |阅读模式
A2 至A7单元格存放的是 身份证号码,想通过程序判断每行的性别,将结果显示在B2至B7 单元格:
image.png



我写了一个程序:

Sub ID()
Dim i As Integer, L As Integer, J As Integer
For i = 2 To 7
L = Len(Sheets(2).Cells(i, 1))

If L <> 15 And L <> 18 Then
MsgBox "Please check your input" & "  " & Sheets(2).Cells(i, 1).Address
Sheets(2).Cells(i, 1) = InputBox("Please reput your ID", "reminder", Sheets(2).Cells(i, 1))

ElseIf L = 18 Then
J = Mid(Sheets(2).Cells(i, 1), 17, 1)
Else
J = Right(Sheets(2).Cells(i, 1), 1)
End If

If J Mod 2 = 0 Then
Sheets(2).Cells(i, 2) = "女"
Else
Sheets(2).Cells(i, 2) = "男"
End If

Next
End Sub


问题:当某单元格的长度不是15和18时,会提示重新输入,但如果重新输入的字符长度既不是15也不是18,程序还是会继续执行。怎么解决?
另外,这个程序能否通过 do while。。。loop 实现:先判断A列的身份证长度是否符合要求,并将不符合的全部改正确,之后再执行判断性别?
菜鸟起步,多多关照! 谢谢!


TA的精华主题

TA的得分主题

发表于 2019-12-5 20:15 来自手机 | 显示全部楼层
问题:当某单元格的长度不是15和18时,会提示重新输入,但如果重新输入的字符长度既不是15也不是18,程序还是会继续执行。怎么解决?
解决方法:在Sheets(2).Cells(i, 1) = InputBox("Please reput your ID", "reminder", Sheets(2).Cells(i, 1))这一行之后另起一行写上call ID()即可

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-5 20:52 | 显示全部楼层
999110022 发表于 2019-12-5 20:15
问题:当某单元格的长度不是15和18时,会提示重新输入,但如果重新输入的字符长度既不是15也不是18,程序还 ...

好像还有问题:

假如: A2单元格的值是:        22222222222222(14位数,少1位),当运行程序的时候,提示重新输入,当输入第15位为奇数的时候,理论上得出的性别是 男,但执行的结果是女,二次执行的时候才更新为 男,为什么?

22222222222222       
999999999999999999       
370405198833333       
370405198801223344       
370405198801224       
370405198801223333       
       

TA的精华主题

TA的得分主题

发表于 2019-12-6 08:47 | 显示全部楼层
ElseIf L = 18 Then
J = Mid(Sheets(2).Cells(i, 1), 17, 1)
ElseIf L=15 Then
J = Right(Sheets(2).Cells(i, 1), 1)
End If

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-12-6 10:55 | 显示全部楼层
蓝桥玄霜 发表于 2019-12-6 08:47
ElseIf L = 18 Then
J = Mid(Sheets(2).Cells(i, 1), 17, 1)
ElseIf L=15 Then

改完之后还是有问题:
假如: A2单元格的值是:        22222222222222(14位数,少1位),当运行程序的时候,提示重新输入,当输入第15位为奇数的时候,理论上得出的性别是 男,但执行的结果是女,二次执行的时候才更新为 男,为什么?   谢谢版主!

22222222222222      
999999999999999999      
370405198833333      
370405198801223344      
370405198801224      
370405198801223333

TA的精华主题

TA的得分主题

发表于 2019-12-6 11:49 | 显示全部楼层
Sub 按钮1_Click()

    Dim rng As Range
    For Each rng In Sheet1.Range("A2:A" & Sheet1.UsedRange.Rows.Count)
        Select Case Len(rng)
            Case 15
                If Right(rng, 1) Mod 2 = 0 Then
                    rng.Offset(0, 1) = "女"
                Else
                    rng.Offset(0, 1) = "男"
                End If
                    
            Case 18
                If Mid(rng, 17, 1) * 1 Mod 2 = 0 Then
                    rng.Offset(0, 1) = "女"
                Else
                    rng.Offset(0, 1) = "男"
                End If
               
            Case Else
                MsgBox "Please check your input" & "  " & rng.Address
                rng.Value = InputBox("Please reput your ID", "reminder")
               
        End Select
    Next

End Sub

TA的精华主题

TA的得分主题

发表于 2019-12-6 11:51 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-12-6 12:20 | 显示全部楼层

  1. Sub ID()
  2.     Dim sh As Worksheet, rg As Range
  3.     Dim strID As String, intLen As Integer, strInput As String
  4.     Dim strSex(2) As String, intSex As Integer
  5.     Dim lngRow As Long
  6.    
  7.     Set sh = Sheets("Sheet1")
  8.     strSex(0) = "女": strSex(1) = "男": strSex(2) = ""
  9.    
  10.     For lngRow = 2 To 7
  11.         Set rg = sh.Range("A" & lngRow)
  12.         strID = Trim(rg.Value)
  13.         intLen = Len(strID)
  14.         
  15.         If intLen <> 15 And intLen <> 18 Then
  16.             MsgBox "Please check your input" & "  " & rg.Address(0, 0)
  17.             rg.Select
  18.             strInput = "   "
  19.             'Len(strInput) = 0 表示 取消
  20.             Do Until Len(strInput) = 15 Or Len(strInput) = 18 Or Len(strInput) = 0
  21.                 strInput = Trim(InputBox("Please reput your ID to " & rg.Address(0, 0), "reminder", strID))
  22.                 strID = strInput
  23.             Loop
  24.             
  25.             strID = Trim(strInput)
  26.             intLen = Len(strID)
  27.         End If
  28.         
  29.         If intLen = 0 Then
  30.             intSex = 2
  31.         ElseIf intLen = 18 Then
  32.             intSex = Val(Left(Right(strID, 2), 1)) Mod 2
  33.         Else
  34.             intSex = Val(Right(strID, 1)) Mod 2
  35.         End If
  36.         
  37.         rg.NumberFormat = "@"
  38.         rg.Value = strID
  39.         rg.Offset(0, 1) = strSex(intSex)
  40.             
  41.     Next
  42. End Sub
复制代码

评分

参与人数 1鲜花 +1 收起 理由
W-H + 1 太强大了

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2020-4-9 07:57 , Processed in 0.084299 second(s), 18 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表