VBA写入公式（3）：身份证公式集

提取身份证信息：
1、出生日期； 2、性别； 3、年龄（周岁）； 4、生肖； 5、星座； 6、省份简称； 7、省份全称； 8、退休日期(男60退休，女50退休）； 9、用星号隐藏； 31、退休日期(男60退休，女干部55退休，女50退休）； 21、是否重复

Sub 身份证公式集()'先选择数字所在的一个单元格，在选择大写金额保存的一个单元格。'&两边无空格是公式上的连接符，&两边有空格是vba上的连接符。'带有双引号的外面必须由两重双引号，而且最内侧双引号外不能连接其他字符串。'n = MsgBox("计算剩余日期" & vbCrLf & "选择【重试】：选项2" & vbCrLf & "选择【忽略】：选项3", vbAbortRetryIgnore, "提示")'n = MsgBox("选择【终止】：选项1" & vbCrLf & "选择【重试】：选项2" & vbCrLf & "选择【忽略】：选项3", vbAbortRetryIgnore, "提示")'Debug.Print n'    UserForm1.Show'    Case 1'    MsgBox "你选择了1"inpu = Application.InputBox("请输入数字。  1、出生日期；  2、性别；  3、年龄（周岁）；   4、生肖；   5、星座；   6、省份简称；    7、省份全称；   8、退休日期(男60退休，女50退休）；     9、用星号隐藏；   31、退休日期(男60退休，女干部55退休，女50退休）；     21、是否重复", Type:=1)If inpu < 21 ThenSet rng1 = Application.InputBox(prompt:="鼠标选择数据源的一个单元格", Type:=8)a = rng1.Address(0, 0)Set rng2 = Application.InputBox(prompt:="鼠标选择保存结果一个单元格", Type:=8)b_rc = rng2.Address ' $A$1，双重锁定 lock row and columnb = rng2.Address(0, 0) 'A1, unlock row and columnb_r = rng2.Address(1, 0) 'A$1, rng1.Address(行, 列)，锁定行就是锁定A1中的1.b_c = rng2.Address(0, 1) '$A1ElseIf (inpu > 20) And (inpu < 31) ThenSet rng1 = Application.InputBox(prompt:="鼠标选择数据源的一个单元格,如A1", Type:=8)a = rng1.Address(0, 0)Set rng2 = Application.InputBox(prompt:="鼠标选择数据源一列一个区间段，如A1：A5", Type:=8)b_rc = rng2.Address ' $A$1，双重锁定 lock row and columnb = rng2.Address(0, 0) 'A1, unlock row and columnb_r = rng2.Address(1, 0) 'A$1, rng1.Address(行, 列)，锁定行就是锁定A1中的1.b_c = rng2.Address(0, 1) '$A1Set rng3 = Application.InputBox(prompt:="鼠标选择保存结果一个单元格，如B1", Type:=8)ElseIf (inpu > 30) And (inpu < 41) ThenSelect Case inpuCase 31MsgBox "接着鼠标选择3列单元格，如：干部，男，2022年1月1日。"Set rng1 = Application.InputBox(prompt:="鼠标选择“干部”所在的一个单元格", Type:=8)a = rng1.Address(0, 0)Set rng2 = Application.InputBox(prompt:="鼠标选择“性别”所在的一个单元格", Type:=8)b = rng2.Address(0, 0) 'A1, unlock row and columnSet rng3 = Application.InputBox(prompt:="鼠标选择“出生日期”所在的一个单元格", Type:=8)c = rng3.Address(0, 0)Set rng4 = Application.InputBox(prompt:="鼠标选择保存结果单元格的一个单元格", Type:=8)rng4.Formula = "=IF(" & b & "=" & """男""" & ",EDATE(" & c & ",12*60),IF(" & a & "=" & """干部""" & ",EDATE(" & c & ",12*55),EDATE(" & c & ",12*50)))"'=IF(B2="男",EDATE(C2,12*60),IF(A2="干部",EDATE(C2,12*55),EDATE(C2,12*50)))Exit SubEnd Select'    Else:'        MsgBox "请按要求输入数字"'        Exit SubEnd If'If IsDate(rng1) = False Then MsgBox ("选中的单元格不是日期格式，可能计算结果错误或者程序报错。")Select Case inpuCase 1'rng2.Formula = "=TEXT(Mid(" & a & ",7, 8)," & """00-00-00""" & ")"inpu2 = Application.InputBox("选日期格式请输入数字。  1、1990-11-11；  2、1990/11/11；   3、1990年11月11日；   4、1990.1.1；   5、1990.01.01；     6、1990.01；     7、1990年01月      8、1900年1月         ", Type:=1)If (inpu2 = 1) Or (inpu2 = 2) Or (inpu2 = 3) Or (inpu2 = 4) Or (inpu2 = 5) Or (inpu2 = 6) Or (inpu2 = 7) Or (inpu2 = 8) ThenSelect Case inpu2Case 1rng2.Formula = "=TEXT(Mid(" & a & ",7, 8)," & """0000-00-00""" & ")"Case 2rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e/m/d""" & ")"Case 3rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e年m月d日""" & ")"Case 4rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e.m.d""" & ")"Case 5rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e.mm.dd""" & ")"Case 6rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e.mm""" & ")"Case 7rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e年mm月""" & ")"Case 8rng2.Formula = "=TEXT(TEXT(MID(" & a & ",7, 8)," & """0000-00-00""" & ")" & "," & """e年m月""" & ")"Case ElseMsgBox "请按要求输入数字"End SelectEnd IfCase 2rng2.Formula = "=IF(MOD(MID(" & a & ",17,1),2)," & """男""" & "," & """女""" & "）"Case 3'少输入=运行程序写入单元格，可以看到转化为Excel原公式的样子。'rng2.Formula = "TEXT(SUBSTITUTE(" & a & "," & """.""" & "," & """-""" & ")," & """yyyy年m月d日""" & ")"rng2.Formula = "=DATEDIF(TEXT(MID(" & a & ",7,8)," & """00-00-00""" & "),TODAY()," & """y""" & ")"Case 4rng2.Formula = "=CHOOSE(MOD(MID(" & a & ",7,4)-1900,12)+1," & """鼠""" & "," & """牛""" & "," & """虎""" & "," & """兔""" & "," & """龙""" & "," & """蛇""" & "," & """马""" & "," & """羊""" & "," & """猴""" & "," & """鸡""" & "," & """狗""" & "," & """猪""" & ")"Case 5'            rng2.Formula = "=LOOKUP(--MID(" & a & ",11,4),{321},{" & """白羊座""" & "})"rng2.Formula = "=LOOKUP(--MID(" & a & ",11,4),{120;219;321;420;521;621;723;823;923;1023;1122;1222},{" & """水瓶座""" & ";" & """双鱼座""" & ";" & """白羊座""" & ";" & """金牛座""" & ";" & """双子座""" & ";" & """巨蟹座""" & ";" & """狮子座""" & ";" & """处女座""" & ";" & """天秤座""" & ";" & """天蝎座""" & ";" & """射手座""" & ";" & """摩羯座""" & "})"Case 6rng2.Formula = "=LOOKUP(--LEFT(" & a & ",2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{" & """北京""" & ";" & """天津""" & ";" & """河北""" & ";" & """山西""" & ";" & """内蒙古""" & ";" & """辽宁""" & ";" & """吉林""" & ";" & """黑龙江""" & ";" & """上海""" & ";" & """江苏""" & ";" & """浙江""" & ";" & """安徽""" & ";" & """福建""" & ";" & """江西""" & ";" & """山东""" & ";" & """河南""" & ";" & """湖北""" & ";" & """湖南""" & ";" & """广东""" & ";" & """广西""" & ";" & """海南""" & ";" & """重庆""" & ";" & """四川""" & ";" & """贵州""" & ";" & """云南""" & ";" & """西藏""" & ";" & """陕西""" & ";" & """甘肃""" & ";" & """青海""" & ";" & """宁夏""" & ";" & """新疆""" & ";" & """台湾""" & ";" & """香港""" & ";" & """澳门""" & "})"Case 7rng2.Formula = "=LOOKUP(--LEFT(" & a & ",2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{" & """北京市""" & ";" & """天津市""" & ";" & """河北省""" & ";" & """山西省""" & ";" & """内蒙古自治区""" & ";" & """辽宁省""" & ";" & """吉林省""" & ";" & """黑龙江省""" & ";" & """上海市""" & ";" & """江苏省""" & ";" & """浙江省""" & ";" & """安徽省""" & ";" & """福建省""" & ";" & """江西省""" & ";" & """山东省""" & ";" & """河南省""" & ";" & """湖北省""" & ";" & """湖南省""" & ";" & """广东省""" & ";" & """广西壮族自治区""" & ";" & """海南省""" & ";" & """重庆市""" & ";" & """四川省""" & ";" & """贵州省""" & ";" & """云南省""" & ";" & """西藏自治区""" & ";" & """陕西省""" & ";" & """甘肃省""" & ";" & """青海省""" & ";" & """宁夏回族自治区""" & ";" & """新疆维吾尔自治区""" & ";" & """台湾省""" & ";" & """香港特别行政区""" & ";" & """澳门特别行政区""" & "})"Case 8rng2.Formula = "=EDATE(TEXT(MID(" & a & ",7,8)," & """0!/00!/00""" & "),MOD(MID(" & a & ",15,3),2)*120+600)"Case 9rng2.Formula = "=REPLACE(" & a & ",7,8," & """********""" & ")"Case 21rng3.Formula = "=IF(COUNTIF(" & b_r & "," & a & "&" & """*""" & ")>1," & """重复""" & "," & """""" & ")"Case ElseMsgBox "请按要求输入数字"End SelectEnd Sub

上述代码的备注：

'出生日期 = Text(Mid(C3, 7, 8), "00-00-00")
'性别=IF(MOD(MID(C3,17,1),2),"男","女")
'
'年龄（周岁） =DATEDIF(TEXT(MID(C3,7,8),"00-00-00"),TODAY(),"y")。'退休年龄=EDATE(D3,MOD(MID(C3,17,1),2)*120+600)
'判断是否重复=IF(COUNTIF(C$3:C$9,C3&"*")>1,"重复","")
'=EDATE(D3,MOD(MID(C3,17,1),2)*120+600)=EDATE(D3,1*120+600)；否则为=EDATE(D3,0*120+600)，即在出生日期的后面加上720个月（60岁）或者600个月（50岁）即可。'生肖=CHOOSE(MOD(MID(B2,7,4)-1900,12)+1,"鼠","牛","虎","兔","龙","蛇","马","羊","猴","鸡","狗","猪")。
'不能用：星座=LOOKUP(--TEXT(C2,"mdd"),{101,"摩羯座";120,"水平座";219,"双鱼座";321,"白羊座";420,"金牛座";521,"双子座";621,"巨蟹座";723,"狮子座";823,"处女座";923,"天秤座";1023,"天蝎座";1122,"射手座";1222,"摩羯座"})
'星座=LOOKUP(--MID(E3,11,4),{120;219;321;420;521;621;723;823;923;1023;1122;1222},{"水瓶座";"双鱼座";"白羊座";"金牛座";"双子座";"巨蟹座";"狮子座";"处女座";"天秤座";"天蝎座";"射手座";"摩羯座"})
'https://www.163.com/dy/article/ER1KFJK6053670IG.html
'省份=LOOKUP(--LEFT(F2,2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{"北京市";"天津市";"河北省";"山西省";"内蒙古自治区";"辽宁省";"吉林省";"黑龙江省";"上海市";"江苏省";"浙江省";"安徽省";"福建省";"江西省";"山东省";"河南省";"湖北省";"湖南省";"广东省";"广西壮族自治区";"海南省";"重庆市";"四川省";"贵州省";"云南省";"西藏自治区";"陕西省";"甘肃省";"青海省";"宁夏回族自治区";"新疆维吾尔自治区";"台湾省";"香港特别行政区";"澳门特别行政区"})
'省份简称=LOOKUP(--LEFT(F2,2),{11,12,13,14,15,21,22,23,31,32,33,34,35,36,37,41,42,43,44,45,46,50,51,52,53,54,61,62,63,64,65,71,81,82},{"北京";"天津";"河北";"山西";"内蒙古";"辽宁";"吉林";"黑龙江";"上海";"江苏";"浙江";"安徽";"福建";"江西";"山东";"河南";"湖北";"湖南";"广东";"广西";"海南";"重庆";"四川";"贵州";"云南";"西藏";"陕西";"甘肃";"青海";"宁夏";"新疆";"台湾";"香港";"澳门"})
'退休日期=EDATE(TEXT(MID(A2,7,8),"0!/00!/00"),MOD(MID(A2,15,3),2)*120+600)
'先利用Text函数计算出出生的年月信息，然后用MOD、MID函数计算性别码和2相除的余数，余数是1，则后续的计算就是720个月，也就是男性60年退休，余数是0，就是600个月，女性50年退休。然后再用EDATE函数返回出生年月为准的日期，就自动得出了退休的时间。
'关于身份证号码的6个函数公式实用技巧解读!
'https://www.163.com/dy/article/EFR7RDNO05360SWT.html'分3种情况：男性60周岁退休、女干部55周岁退休、女工人50周岁退休。
'excel身份证号计算退休日期，我们只需要在D2单元格输入公式：
'=IF(B2="男",EDATE(C2,12*60),IF(A2="干部",EDATE(C2,12*55),EDATE(C2,12*50)))'=TEXT(C3,"e年m月d日"), 要求C3是日期格式。如不是日期格式，需要先转日期格式：=TEXT(TEXT(G54,"00-00-00"),"e年m月d日")
'=TEXT(TEXT(MID(F62,7,8),"00-00-00"),"e年m月d日")
'星号隐藏=REPLACE(F71,7,8,"********")

VBA写入公式（3）：身份证公式集相关推荐

表白套路计算机公式,数学情话大全浪漫情话套路句子数学情话表白公式短句说说合集...
都说理科生很古板,学理科的也一般都是直男直女,特别是学数学的,除了公式之外还是公式,但是就是这样枯燥古板的数学,却也有着很多人不懂的情话表白句子哦.下面带来:数学情话大全浪漫情话套路句子数学情话表白 ...
poi导出excel写入公式_【java poi 写入Excel后读取公式值问题】poi导入excel
java poi 写入Excel后读取公式值问题不用改公式,只需要用cell.getNumericCellValue()获取,读出来就是正确的值了,如果你读出来的还有问题,说明你其他的地方写的还有问 ...
JAVA 向带有公式的excel写入数据，获取公式计算结果
JAVA 向带有公式的excel写入数据,获取公式计算结果 public static void main(String[] args) throws Exception {String url = ...
计算机公式等于,Excel公式：计算等于
Excel公式:计算等于本文将重点介绍Excel公式,该公式用于计算完全等于您指定的文本字符串或部分等于给定文本字符串的单元格,如下面的屏幕截图所示. 首先,它将解释公式的语法和参数,并提供示例供您 ...
Office word中mathtype公式与LaTex公式代码互转
在word中,输入好的mathtype公式已经嵌入到word内容中了,如何转成LaTex公式代码呢? 很简单,mathtype已经内置了相关功能和快捷键,按钮在word中[MathType]-[Pub ...
排列公式和组合公式_排列与组合：排列公式与组合公式之间有什么区别？
排列公式和组合公式 Here's the short version. 这是简短的版本. Let's take ringing bells in a church as an example. 让我们 ...
利用制表位快速居中对齐公式，同时公式编号靠右对齐
(1)首先在任意空行选择"开始"-->"段落"-->"段落设置"-->"缩进和间距"-->&qu ...
word2016实现制表法设置公式居中，公式居中，编号右对齐
思路:改变指标符的位置,新建样式名称自由修改,我设置为论文公式,后续段落样式设置为正文(为了不影响后续操作啥的) 格式下选制表位第一个制表位位置为7.32厘米,第二个制表位位置17.82厘米,注意 ...
Word编辑公式时，公式后的序号靠下，不能再行中间显示
Word编辑公式时,公式后的序号靠下,不能再行中间显示解决方法: 鼠标放在该行,右键->段落->中文版式->"文本对齐方式"选"居中"-&g ...

VBA写入公式（3）：身份证公式集

VBA写入公式（3）：身份证公式集相关推荐

最新文章

热门文章