在视频教程中我为大家展示了怎么使用VBA编程,一键就可以通过身份证号码获取到个人相关信息。视频教程限于篇幅没法给大家详细讲解代码,所以这篇文章将为大家带来视频中展示的代码的详细讲解。
基础知识在excel的文档中如果插入了宏的代码,那么我们需要把文件保存为.xlsm格式,并且打开excel工作簿的时候要启用宏。
按住alt+f11能调出VBA的代码编辑器。
【开发工具】选下卡的插入可以插入按钮等表单控件。
在VBA代码编辑器中定义好一个宏后,可以插入一个按钮,然后右键点击按钮指定宏,这样能给按钮指派宏,当点击按钮就会触发宏当中的VBA代码。
实现一键提取信息的步骤我们要实现通过选中批量的身份证信息,然后使用VBA代码一键获取性别、出生年月日以及年龄等信息的步骤如下:
1.获取选中的单元格内容
2.判断是否选中了多个单元格
3.判断是否选中的是同一列的单元格
4.循环遍历选中的身份证信息,截取对应位数的数字,判断性别、生日
5.根据当前时间和生日,用函数算出年龄
6.把算出的信息放在对应单元格上面
代码讲解全局代码如下:
这一段是定义一个名字叫【从身份证号码获取信息】的宏,End Sub是结尾,中间是功能代码:
Sub 从身份证号码获取信息()
......
End Sub
这一段是在定义后面可能会用到的变量,变量相当于存放数据的盒子:
Dim rng As Range, i As Integer, Mystr As String, arr, arr2()
这一段是在判断当前你在工作表中是否选中了单元格,如果没选中就会报出错误信息并退出执行代码,后面的代码不会再执行,出现Exit Sub就会终止执行后面的代码:
If TypeName(Selection) "Range" Then MsgBox "请选择存放身份证号码的区域": Exit Sub
返回选中单元格和当前活动sheet中有内容的单元格间重复的单元格,也就是去除你选中了,但是没有值的空单元格,Intersect是一个函数,这个函数的作用是返回两个参数中的单元格部分的重合部分:
Set rng = Intersect(Selection, ActiveSheet.UsedRange)
这两段代码也是在判断和限制你选中的单元格内容,就不做详细讲解了,请参考代码注释:
If rng.Columns.Count 1 Then MsgBox "只能选择单列", vbOKOnly + vbInformation, "出错提示": Exit Sub
If rng(1) = "" Then MsgBox "请选择身份证号码存放区域", vbOKOnly + vbInformation, "出错提示": Exit Sub
这里是在开始进行循环,然后处理相似的操作,为什么要循环,这是因为,我们对几个身份证号码进行提取的规则是一样的,变化的只是号码不同,所以这就可以用循环来实现,否则一个一个写代码会非常多也很麻烦:
For i = 1 To UBound(arr)
......
Next i
截取身份证号从第15位开始,总共取3位,然后除以2取余数,Mod是取余数的操作。如果余数是1就是奇数,那么就是男,反之位0那么就是偶数,性别就是女。
arr2(i, 1) = IIf((Mid(arr(i, 1), 15, 3) Mod 2), "男", "女")
身份证号如果是15位,并且第7位如果是0,那么证明是00后,那么生日的年份就要加上20,然后取7,8位和20拼接起来,组成年份,中加用“-”连接,然后9,10位位月份;11,12位为日,这样就组成了出生生日:
If Len(arr(i, 1)) = 15 And Mid(arr(i, 1), 7, 1) = 0 Then Mystr = "20" & Mid(arr(i, 1), 7, 2) & "-" & Mid(arr(i, 1), 9, 2) & "-" & Mid(arr(i, 1), 11, 2)
和上面类似,15位身份证,当第7位大于0就应该在前面加上19,而不是加20,其余部分和上面一样:
If Len(arr(i, 1)) = 15 And Mid(arr(i, 1), 7, 1) 0 Then Mystr = "19" & Mid(arr(i, 1), 7, 2) & "-" & Mid(arr(i, 1), 9, 2) & "-" & Mid(arr(i, 1), 11, 2)
18位的身份证,这个内容较简单,相信大家根据上面的讲解能够举一反三:
If Len(arr(i, 1)) = 18 Then Mystr = Mid(arr(i, 1), 7, 4) & "-" & Mid(arr(i, 1), 11, 2) & "-" & Mid(arr(i, 1), 13, 2)
Evaluate函数能把字符串内容,当作代码去执行,这段代码主要是为了执行DATEDIF函数用当前时间减去生日,这样就能计算出年龄:
arr2(i, 3) = Evaluate("DATEDIF(" & DateSerial(Split(Mystr, "-")(0), Split(Mystr, "-")(1), Split(Mystr, "-")(2)) * 1 & ", NOW()," & """Y""" & ")")
这里就是在做赋值的工作,前面所有计算结果都是放在arr2这个变量中,我们可以理解为放在arr2盒子中,这段代码执行后就会把计算结果放在相应的单元格中了。
rng.Offset(0, 1).Resize(UBound(arr), 3) = arr2
结语本文TAG:vb视频教程
- 上一篇: 网游之巅峰(网游之巅峰战神)
- 下一篇: 中世纪工程师_中世纪工程师mod
猜你喜欢
- 2023-08-30赤炎单职业传奇嬉戏里做事押镖任务中有什么方法?讨论赤炎单职业传奇每日押镖任务帮扶你极快升级
- 2023-08-30龙吟单职业传奇中帮你如何搭配夫妻传送功能(龙吟单职业传奇攻略详解)
- 2023-08-30首次接触合击传奇卡怪游戏玩家的绝对晓得的最好怪物,,跟合击传奇卡怪中最先起步的高好机会打宝地图无保留分享传授
- 2023-08-30【双通单职业传奇攻略】双通单职业传奇背包东西扔不出去是怎么回事
- 2022-02-22新开传奇手游使用拍卖行用于交易时最好提前沟通好
- 2022-02-22有哪些方法可以让我们弄到元宝
- 最近发表
- 标签列表
-
- 传奇手游私服 (7)
- 新开传奇手游网站 (7)
- 传奇单职业 (2)
- 传奇手游变态版 (1)
- 传奇发布网 (7)
- 传奇sf手游版 (1)
- 新开传奇 (1)
- 传奇私服 (1)
- 拳皇7k7k小游戏 (0)
- nitrome小游戏 (0)
- 最新传奇发布网 (0)
- 每日新开传奇网 (0)
- 找176复古传奇 (0)
- 超级变态热血传奇 (0)
- nba2k11最新名单 (0)
- 王者荣耀更新 (0)
- 王者荣耀体验服申请 (0)
- 英雄联盟出装顺序 (0)
- 三国志单机游戏 (0)
- 王者荣耀宫本武藏符文 (0)
- 梦幻西游109神器任务攻略 (0)
- 下载英雄联盟 (0)
- 机械公敌兰博出装 (0)
- 王者荣耀西施 (0)
- 王者荣耀无限火力 (0)
- 不知火舞王者荣耀 (0)
- 300英雄三笠出装 (0)
- 冒险岛2职业 (0)
- 龙将2官网 (0)
- 热血传奇怀旧版好玩吗 (0)
- 传奇超级 (0)
- 传奇师服 (0)
- 迷失传奇发布网 (0)
- 韩版传奇私服发布网 (0)
- 传世新开 (0)
- 传奇2外挂 (0)
- 传奇复古 (0)
- 单职业变态 (0)
- 传奇sf180 (0)
- 传世sf吧 (0)
- 传奇私服gm命令大全 (0)
- 传奇世界私服刷元宝 (0)
- dnf私服发布网 (0)
- 网页三国游戏排行榜 (0)
- 傲视千雄私服 (0)
- 热血传奇176客户端下载 (0)
- 最新机战私服 (0)
- 传奇吉吉免费版 (0)
- 蜘蛛纸牌游戏 (0)
- 最热门的网游排行榜 (0)
- 2d网游 (0)
- 网游私服排行榜 (0)
- moba网游 (0)
- 439小游戏 (0)
- 飞车小游戏 (0)
- 奥奇传说小游戏 (0)
- 龙斗士小游戏 (0)
- 下载手机游戏 (0)
- 维京神域之战 (0)
- 星际2单机 (0)
- 防守类单机游戏 (0)
- 灰烬攻略 (0)
- 战神3pc版 (0)
- 腐尸之屋 (0)
- 新神奇传说3秘籍 (0)
- 生化危机5怎么存档 (0)
- 三国群英传1单机版下载 (0)
- 捕鱼达人手机版 (0)
- 仙剑奇侠传游戏1 (0)
- 暴力摩托单机版下载 (0)
- fifa12下载 (0)
- 色单机游戏 (0)
- 三国志13修改器 (0)
- 梦幻西游单机版神剑情天3 (0)
- 对打单机游戏 (0)
- 三国群英传7补丁 (0)
- 最好单机游戏下载 (0)
- 流星蝴蝶剑秘籍大全 (0)
- 孢子 (0)
- 梦幻西游赚钱 (0)
- 梦幻西游答题 (0)
- 王者荣耀防沉迷 (0)
- 梦幻西游挖图技巧 (0)
- 梦幻岛游戏 (0)
- 轩辕剑网游官网 (0)
- 梦幻西游手游论坛 (0)
- 极道阴阳师 (0)
- 仙剑奇侠传3下载 (0)
- 七龙珠人物换装2 (0)
- 赛尔号手机版下载 (0)
- lol战队名字 (0)
- 黑湾海盗中文版 (0)
- 超级街霸4街机版 (0)
- 侵略行为 (0)
- 孤岛惊魂3结局 (0)
- 龙珠单机游戏大全 (0)
- 仙剑三游戏下载 (0)
- 策略单机游戏 (0)
- 家园2简体中文版 (0)
- 现代战争2 (0)