实现的效果是“点击一键填写性别和年龄”,表的呈现如下:
代码如下:
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.点击确定后,根据自己的需要给按钮命名