Excel:vba实现身份信息填写

 实现的效果是“点击一键填写性别和年龄”,表的呈现如下:

代码如下:

Sub 判断性别年龄()
    Dim idCard As String
    Dim birthDate As String
    Dim nian As Integer, yue As Integer, ri As Integer
    Dim currentDate As Date
    Dim age As Integer
    Dim gender As String
    
    ' lastrow = Cells(Rows.Count,1).End(xlUp).Row找出表的最后一行
    lastrow = ActiveSheet.UsedRange.Rows.Count 

    For i = 2 To lastrow:
         ' 身份证号所在单元格
         idCard = CStr(Cells(i, 3).Value)
    
        '提取出生日期(第7到14位),比如第七位到第14位是19681123,就是1968年11月23日
         birthDate = Mid(idCard, 7, 8)
        '从19681123左边开始找四个,即1968就是要找的年份
        nian = CInt(Left(birthDate, 4))
        '从19681123的第五位开始,找两个,即11就是要找的月份
         yue = CInt(Mid(birthDate, 5, 2))
        '从19681123的右边开始,找两个,即23就是要找的日
         ri = CInt(Right(birthDate, 2))
       
        ' 获取当前日期2024-10-8
        currentDate = Date
    
        ' 计算年龄2024-1968=58
        age = Year(currentDate) - nian
        '如果当前2024年的10月份小于生日的月份或者(等于生日的月份但是日期小于生日的日期)
        If Month(currentDate) < yue Or (Month(currentDate) = yue And Day(currentDate) < ri) Then
        age = age - 1  '说明还没过2024年的生日,所以58-1=57
        End If
    
        ' 判断性别(第17位,奇数为男性,偶数为女性)
        If CInt(Mid(idCard, 17, 1)) Mod 2 = 0 Then
            gender = "女"
            Cells(i, "d").Value = gender
            Cells(i, "e").Value = age
        Else
            gender = "男"
            Cells(i, "d").Value = gender
            Cells(i, "e").Value = age
        End If
    Next i
    ' 输出结果
End Sub

按钮的插入:

1.插入按钮控件

2.指定控件运行的宏

3.点击确定后,根据自己的需要给按钮命名

评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值