最新WPS办公软件学习教程_免费企业办公软件下载_金山WPS Office官网论坛

 找回密码
 
查看: 11748|回复: 30

[VBA/VBS教程] 身份证转出生日期一劳永逸的解决方案

  [复制链接]

84

主题

61

听众

3088

积分

测试体验团员

系统分析师

Rank: 14Rank: 14Rank: 14Rank: 14

该用户从未签到

金币
984
威望
8204
帖子
842
精华
3

WPS粉丝团 技术分享团 解答支持团 测试体验团 重阳节勋章 技巧教程分享达人 最佳教程奖 优秀会员奖

发表于 2012-10-15 21:11 |显示全部楼层
分享到: 新浪微博 腾讯微博
ET中有此功能,但是ET会忽略月份和日子里面的首位的07 [$ m& N) J+ u3 \* S
即ET中会出现这种情况:/ z. p  |! F3 W6 ?0 O
2012-1-1# {2 Y* w+ Z4 n8 r9 a4 ]
而很多时候,我们对格式的要求很高,比如一定要如下的格式:
6 s0 D# A& O! A% _* y$ [2012-01-01: D0 A4 B1 f" t
而且,只能用"-"连接也可能在有时不适用,比如我们要这样的格式
6 X8 m$ R1 A3 h+ h+ _2012/01/01; b* V) V1 Z$ e4 n
或者
( Y- F$ ?) I0 M, n9 x  u0 I2012年01月01月
* U- G( n' u  C+ M8 I2 z8 f此时,在ET在可能的解决办法是设置单元格格式,自定义格式。3 n  P2 f& i/ _7 w7 |
但是,这样太麻烦,而且不一定能达到我们想要的格式。
, |& B8 L5 w. O: w) T% v为此,我们使用VBA开发自定义函数。
  1. '身份证转出生日期1
    & K: j3 N' t' {
  2. '产生的格式形如 2012-01-01 ,其中,"-" 可由第二参数替换为任意字符,比如2012/01/01
    ( |, F2 h  H7 z6 X' V
  3. Public Function SFZtoDate(ByVal cell As Range, Optional ByVal strAnd As String = "-")6 [" h( W, U  X
  4. Application.ScreenUpdating = False '关闭屏幕更新,加快速度) k; }- y$ t; F$ @7 Z% j
  5. On Error Resume Next '防错处理8 I1 \! z7 _! }4 E) `9 ^
  6. If Len(cell) = 0 Then SFZtoDate = "": Exit Function '如果引用单元格空白则返回空白,且终止函数过程0 ~+ Z8 p: E; e  D: L8 f! o  I
  7. If Len(cell.Text) <> 15 And Len(cell.Text) <> 18 Then SFZtoDate = "": Exit Function '如果引用单元格长度不是15或者18则返回空白,且终止函数过程1 P; u! s# a$ G2 K
  8. '如果身份证号为15位,而且第7位数是0,那么使用“20”连接第7位开始6位数,且使用strAnd作为年、月、日的分隔符,结果为出生日期
    0 F8 v4 t( y5 Q% r0 T: n( Y/ I
  9. If Len(cell.Text) = 15 And Mid(cell.Text, 7, 1) = 0 Then SFZtoDate = "20" & Mid(cell.Text, 7, 2) & strAnd & Mid(cell.Text, 9, 2) & strAnd & Mid(cell.Text, 11, 2)
    2 r) |, [9 P7 K% {  ?  K
  10. '如果身份证号为15位,而且第7位数大于0,那么使用“19”连接第7位开始6位数,且使用 strAnd作为年、月、日的分隔符,结果为出生日期  x2 a4 G: b3 l$ l, e6 x1 Y
  11. If Len(cell.Text) = 15 And Mid(cell.Text, 7, 1) > 0 Then SFZtoDate = "19" & Mid(cell.Text, 7, 2) & strAnd & Mid(cell.Text, 9, 2) & strAnd & Mid(cell.Text, 11, 2)
    / V: `2 v; F' p6 U% K5 @) W
  12. '如果身份证号为18位,那么从第7位开始取8位数,且使用strAnd作为年、月、日的分隔符,结果为出生日期(第7到14位表示出生年月日): a# s- U/ V+ F6 E2 g
  13. If Len(cell.Text) = 18 Then SFZtoDate = Mid(cell.Text, 7, 4) & strAnd & Mid(cell.Text, 11, 2) & strAnd & Mid(cell.Text, 13, 2)
    # _& N! q; x) t
  14. Application.ScreenUpdating = True '恢复屏幕更新0 S) ?# m" s: |" i1 v: q: n0 p
  15. End Function/ d& g" }  l5 O7 ^1 T
  16. '身份证转出生日期2* V. w8 w5 y" @* T0 z; E
  17. '产生的格式形如 2012年01月01日 ,其中,"年","月","日" 可由第2-4参数替换为任意字符,比如2012Year01Month01Day% [% e, U2 s8 j! q; P6 e
  18. Public Function SFZtoDateEx(ByVal cell As Range, Optional ByVal strY As String = "年", Optional ByVal strM As String = "月", Optional ByVal strD As String = "日")+ k$ w1 l2 V; j7 i3 [
  19. Application.ScreenUpdating = False '关闭屏幕更新,加快速度
    & d/ u0 Q# D0 v8 L& w! I+ ]
  20. On Error Resume Next
    1 h' j' i  a  v5 J! h1 P8 Z) w6 \. w
  21. If Len(cell) = 0 Then SFZtoDateEx = "": Exit Function8 L4 A8 ^. L2 s7 `. R; O, C
  22. If Len(cell.Text) <> 15 And Len(cell.Text) <> 18 Then SFZtoDateEx = "": Exit Function8 d: V. e- {, l, ]& q7 i
  23. If Len(cell.Text) = 15 And Mid(cell.Text, 7, 1) = 0 Then SFZtoDateEx = "20" & Mid(cell.Text, 7, 2) & strY & Mid(cell.Text, 9, 2) & strM & Mid(cell.Text, 11, 2) & strD) k  \% `& S; V" z8 }
  24. If Len(cell.Text) = 15 And Mid(cell.Text, 7, 1) > 0 Then SFZtoDateEx = "19" & Mid(cell.Text, 7, 2) & strY & Mid(cell.Text, 9, 2) & strM & Mid(cell.Text, 11, 2) & strD
    1 u7 j( l) G2 O! v& ~# _$ Q
  25. If Len(cell.Text) = 18 Then SFZtoDateEx = Mid(cell.Text, 7, 4) & strY & Mid(cell.Text, 11, 2) & strM & Mid(cell.Text, 13, 2) & strD: t. t3 A4 x; |7 Z
  26. Application.ScreenUpdating = True '恢复屏幕更新2 |5 |7 j3 u$ @, E" F, W$ [4 |
  27. End Function
复制代码
利用自定义函数,我们可以实现如图的功能:
1 b) {2 n4 N; S$ DC2,C8,C14,C20四个单元格的公式分别为:
  1. =SFZtoDate(A2)
    . h! I* M- ?% p6 h1 X- t+ Z" H
  2. =SFZtoDate(A8,"/")& t$ P8 {4 q# T; x+ c- v
  3. =SFZtoDateEx(A14)
    ! n9 z6 {4 y9 A) |) T7 r3 S
  4. =SFZtoDateEx(A20,"Year","Month","Day")
复制代码
附件为演示用的ET文档,供参考使用。本人第一次发贴,多多关照,不当之处请赐教!# K& p7 W& J, X' B
2 ?( x& ^8 g( E. f6 ^

本帖子中包含更多资源

您需要 登录 才可以下载或查看,

已有 2 人评分威望 收起 理由
zhouyiran1@126.com + 15 赞一个!
松风水月 + 15 赞一个!

总评分: 威望 + 30   查看全部评分

热爱分享和学习。希望WPS论坛越办越好,WPS软件越做越好。也希望能在这里交到更多志同道合的朋友。我的邮箱:ypr@yprnet.com
我在WPS论坛上的教程帖子合集: http://blog.yprnet.com/wps

58

主题

1

听众

2740

积分

LV.9

Rank: 9Rank: 9Rank: 9

签到天数: 3 天

[LV.2]偶尔看看I

金币
210
威望
5798
帖子
1875
精华
0

优秀会员奖 活跃会员奖 测试体验团

发表于 2012-10-15 22:58 |显示全部楼层
谢谢分享
回复

使用道具 举报

1

主题

0

听众

9

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
17
帖子
8
精华
0
发表于 2012-10-15 23:12 |显示全部楼层
高手在明间呀 多谢分享了  
回复

使用道具 举报

19

主题

111

听众

5338

积分

技术分享团长

Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20

签到天数: 5 天

[LV.2]偶尔看看I

金币
5316
威望
11825
帖子
2334
精华
1

WPS粉丝团 荣誉版主奖 活跃会员奖 技术分享团 解答支持团 重阳节勋章

发表于 2012-10-16 01:32 |显示全部楼层
本帖最后由 松风水月 于 2012-10-16 01:34 编辑 - r5 k+ `1 D2 G  e

: N) `) n/ S2 L/ q9 X谢谢楼主的分享,真是辛苦了!楼主编写的程序考虑很细致,前面加了防错处理,如果引用单元格空白,或者单元格位数不是15位或18位,则返回空白。而且还考虑了如果身份证号为15位,且第7位数是0的情况。楼主还给程序代码加了详细的注释,方便大家的理解。非常谢谢楼主!3 e5 v  e- p. J" C7 N
& e( B3 A2 ^- O* J5 j8 }. b
下面是我阅读完这篇帖子后的两点想法,希望和楼主一起讨论。( M  H2 u5 I4 g3 M2 O) i
, B0 O- E8 H) J4 J' h5 \9 b
一个是防错处理方面的。是否要再加上一个步骤,判断输入身份证单元格中的内容是否为纯数字,或纯数字+字母X。$ K* {3 W" J& S$ u

( X' T- J! D& X1 H( C二是年份处理方面的。我查了下新闻,第二代身份证是2004年开始换发的,而此前好像只有满16岁才能领身份证,那就是说,2000年及以后出生的人,应该是只会领到二代证,不会领到一代证的。那么身份证号为15位,且第7位数是0的情况,所代表的年份,应该还是190X年,而不是200X年。
回复

使用道具 举报

19

主题

111

听众

5338

积分

技术分享团长

Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20

签到天数: 5 天

[LV.2]偶尔看看I

金币
5316
威望
11825
帖子
2334
精华
1

WPS粉丝团 荣誉版主奖 活跃会员奖 技术分享团 解答支持团 重阳节勋章

发表于 2012-10-16 02:02 |显示全部楼层
本帖最后由 松风水月 于 2012-10-16 02:58 编辑 4 a8 P: b9 U' x! J* f* @

' |: j5 ?# [% K* }; n! E% o另外补充一下用函数的方法来实现这个需求的方法,关键是使用 TEXT 函数。
5 M5 c1 }7 ?5 U* ]# h* q0 y2 m+ P# |* y, Y) _
假设输入身份证号码的单元格为 A1,提取年份的单元格为 B1。0 n  `# k7 j9 q2 c

' ]. m2 m4 T: K8 O# [1、如果需要的日期格式为:yyyy年mm月dd日 (例:1900年01月23日),则在 B1 单元格使用公式:
  1. =IF(LEN(B1)=15,TEXT(MID(B1,7,6),"1900年00月00日"),IF(LEN(B1)=18,TEXT(MID(B1,7,8),"0000年00月00日"),""))
复制代码
2、如果需要的日期格式为:yyyy-mm-dd (例:1900-01-23),则在 B1 单元格使用公式:
  1. =IF(LEN(B1)=15,TEXT(MID(B1,7,6),"1900-00-00"),IF(LEN(B1)=18,TEXT(MID(B1,7,8),"0000-00-00"),""))
复制代码
3、如果需要的日期格式为:yyyy/mm/dd (例:1900/01/23),则在 B1 单元格使用公式:
  1. =IF(LEN(B1)=15,TEXT(MID(B1,7,6),"1900\/00\/00"),IF(LEN(B1)=18,TEXT(MID(B1,7,8),"0000\/00\/00"),""))
复制代码
或者在第二个公式外面再嵌套一个 TEXT 函数:
  1. =TEXT(IF(LEN(B1)=15,TEXT(MID(B1,7,6),"1900-00-00"),IF(LEN(B1)=18,TEXT(MID(B1,7,8),"0000-00-00"),"")),"yyyy/mm/dd")
复制代码
4、如果需要的日期格式为:mmmm-dd-yyyy(例:January-23-1990),则只能使用再嵌套一个 TEXT 函数的方法了:
  1. =TEXT(IF(LEN(B1)=15,TEXT(MID(B1,7,6),"1900-00-00"),IF(LEN(B1)=18,TEXT(MID(B1,7,8),"0000-00-00"),"")),"mmmm-dd-yyyy")
复制代码
回复

使用道具 举报

6

主题

3

听众

144

积分

LV.3

Rank: 3Rank: 3

该用户从未签到

金币
20
威望
220
帖子
133
精华
0
发表于 2012-10-16 11:31 |显示全部楼层
分享了{:soso_e183:}
回复

使用道具 举报

84

主题

61

听众

3088

积分

测试体验团员

系统分析师

Rank: 14Rank: 14Rank: 14Rank: 14

该用户从未签到

金币
984
威望
8204
帖子
842
精华
3

WPS粉丝团 技术分享团 解答支持团 测试体验团 重阳节勋章 技巧教程分享达人 最佳教程奖 优秀会员奖

发表于 2012-10-16 12:06 |显示全部楼层
@松风水月 看了你的回贴,我在认真研究一下,出个改进版,太谢谢你的建议了
热爱分享和学习。希望WPS论坛越办越好,WPS软件越做越好。也希望能在这里交到更多志同道合的朋友。我的邮箱:ypr@yprnet.com
我在WPS论坛上的教程帖子合集: http://blog.yprnet.com/wps
回复

使用道具 举报

2

主题

0

听众

19

积分

LV.1

Rank: 1

该用户从未签到

金币
0
威望
14
帖子
8
精华
0
发表于 2012-10-20 13:20 |显示全部楼层
好东西啊
回复

使用道具 举报

13

主题

2

听众

2150

积分

活动策划团员

Rank: 14Rank: 14Rank: 14Rank: 14

签到天数: 13 天

[LV.3]偶尔看看II

金币
508
威望
5892
帖子
576
精华
0

活动策划团

发表于 2012-10-23 08:31 |显示全部楼层
学习了{:1_14:}
回复

使用道具 举报

5

主题

0

听众

165

积分

LV.3

Rank: 3Rank: 3

该用户从未签到

金币
94
威望
398
帖子
81
精华
0
发表于 2012-10-26 22:42 |显示全部楼层
不错,重在琢磨
回复

使用道具 举报

*滑动验证:
您需要登录后才可以回帖 登录 | 更多账号登录:

快速回帖:

fastpost

WPS论坛更新日志|WPS Office官方论坛 ( 粤公网安备 44049102496073号 粤ICP备13015957号-1   

GMT+8, 2018-1-22 16:31

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部