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

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

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

  [复制链接]

84

主题

59

听众

3088

积分

测试体验团员

系统分析师

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

该用户从未签到

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

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

发表于 2012-10-15 21:11 |显示全部楼层
分享到: 新浪微博 腾讯微博
ET中有此功能,但是ET会忽略月份和日子里面的首位的0" ?$ s4 C6 v8 m' Z) v
即ET中会出现这种情况:
- {' `$ P+ E. u; x2012-1-1
& r" s- X: M; e1 j: W9 C( [而很多时候,我们对格式的要求很高,比如一定要如下的格式:4 K% R4 b; o5 a$ ]. P
2012-01-01
0 ?! s) m: c& w9 ^而且,只能用"-"连接也可能在有时不适用,比如我们要这样的格式
8 j1 ~9 z) K. W% X# ]- n  N2012/01/01
# `; E4 g: \) M7 T4 {) T: \; `或者" Z$ v  Y" A7 C. D& v
2012年01月01月1 e) ~2 h( w- f- Z2 o, f$ Q
此时,在ET在可能的解决办法是设置单元格格式,自定义格式。
# U. p& p5 `7 O8 J$ f9 l. k但是,这样太麻烦,而且不一定能达到我们想要的格式。, J6 _' d% p6 D; s& `
为此,我们使用VBA开发自定义函数。
  1. '身份证转出生日期1
    * m9 b' g% x2 f- W
  2. '产生的格式形如 2012-01-01 ,其中,"-" 可由第二参数替换为任意字符,比如2012/01/01: p- S! x* L+ s' L2 W
  3. Public Function SFZtoDate(ByVal cell As Range, Optional ByVal strAnd As String = "-")
    0 ~9 ?4 ]" F# R! N7 U& o0 Z
  4. Application.ScreenUpdating = False '关闭屏幕更新,加快速度
    1 a, ^8 x& E3 l+ D) f6 Z& o
  5. On Error Resume Next '防错处理
    1 [# U4 h2 V. K& p& i8 @
  6. If Len(cell) = 0 Then SFZtoDate = "": Exit Function '如果引用单元格空白则返回空白,且终止函数过程
    * r: E. M) b& }/ Z8 X
  7. If Len(cell.Text) <> 15 And Len(cell.Text) <> 18 Then SFZtoDate = "": Exit Function '如果引用单元格长度不是15或者18则返回空白,且终止函数过程$ o( U. ^  [7 V* X; p( _' e, ^
  8. '如果身份证号为15位,而且第7位数是0,那么使用“20”连接第7位开始6位数,且使用strAnd作为年、月、日的分隔符,结果为出生日期4 L1 c3 Y0 J# v
  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)
    ! q8 O6 {4 O4 i1 \: T
  10. '如果身份证号为15位,而且第7位数大于0,那么使用“19”连接第7位开始6位数,且使用 strAnd作为年、月、日的分隔符,结果为出生日期3 Y& }" Z) a7 p
  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)' @/ K" u0 I: ]! C
  12. '如果身份证号为18位,那么从第7位开始取8位数,且使用strAnd作为年、月、日的分隔符,结果为出生日期(第7到14位表示出生年月日)) k: d) u, {% b/ k8 {
  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)
    ) o8 C2 T7 Y9 |3 d- D  l
  14. Application.ScreenUpdating = True '恢复屏幕更新( z, U/ n! x0 U3 I8 y6 w; E  ^
  15. End Function
    - f& v' O4 s( ]5 r
  16. '身份证转出生日期22 ]4 ^2 j# T( F$ y
  17. '产生的格式形如 2012年01月01日 ,其中,"年","月","日" 可由第2-4参数替换为任意字符,比如2012Year01Month01Day; k. \, o3 _5 n( ^- p1 ^2 u# t
  18. Public Function SFZtoDateEx(ByVal cell As Range, Optional ByVal strY As String = "年", Optional ByVal strM As String = "月", Optional ByVal strD As String = "日"). q9 W$ _& j7 W# e
  19. Application.ScreenUpdating = False '关闭屏幕更新,加快速度
    ) L) U. d3 d6 S* W* }
  20. On Error Resume Next
    ; b5 D6 [1 n) c* d5 E# A
  21. If Len(cell) = 0 Then SFZtoDateEx = "": Exit Function
    $ I. Z6 v6 W7 a6 l/ e7 s5 q
  22. If Len(cell.Text) <> 15 And Len(cell.Text) <> 18 Then SFZtoDateEx = "": Exit Function7 J* j) m/ R! s5 r6 s2 p( z
  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+ S. J! P4 q. A$ `( O$ Q. d8 {
  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
    / {) q) z- ~% k8 f- o  D2 x
  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) & strD8 w" H6 D* x  u( E
  26. Application.ScreenUpdating = True '恢复屏幕更新$ |* A! L# Q$ z& ?4 k% [" ?0 g1 i
  27. End Function
复制代码
利用自定义函数,我们可以实现如图的功能:% _$ D4 N+ F' `4 _6 v' H
C2,C8,C14,C20四个单元格的公式分别为:
  1. =SFZtoDate(A2)
    0 Y3 W/ O4 x+ H" E6 s
  2. =SFZtoDate(A8,"/")
    9 Z+ T6 ^! K2 Y6 E+ |# }2 [/ o5 \; B
  3. =SFZtoDateEx(A14)0 I( S( C0 J/ F3 h! T2 s
  4. =SFZtoDateEx(A20,"Year","Month","Day")
复制代码
附件为演示用的ET文档,供参考使用。本人第一次发贴,多多关照,不当之处请赐教!
/ L1 Q7 y# ^) E) E4 X5 I6 ]' n0 r$ X' K1 T( }% c8 C# O

本帖子中包含更多资源

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

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

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

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

58

主题

1

听众

2737

积分

LV.9

Rank: 9Rank: 9Rank: 9

签到天数: 3 天

[LV.2]偶尔看看I

金币
210
威望
5795
帖子
1872
精华
0

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

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

使用道具 举报

1

主题

0

听众

9

积分

LV.1

Rank: 1

该用户从未签到

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

使用道具 举报

19

主题

106

听众

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 编辑
2 g1 E0 b0 L( s, S! h9 d9 _* q/ @' q
谢谢楼主的分享,真是辛苦了!楼主编写的程序考虑很细致,前面加了防错处理,如果引用单元格空白,或者单元格位数不是15位或18位,则返回空白。而且还考虑了如果身份证号为15位,且第7位数是0的情况。楼主还给程序代码加了详细的注释,方便大家的理解。非常谢谢楼主!+ u% _1 I! w( A7 j% h) b% j

5 i% y' U$ s5 r2 f% J$ V2 T- b下面是我阅读完这篇帖子后的两点想法,希望和楼主一起讨论。7 _2 p  t0 q/ x1 t
! s% P* @4 {- n$ j- N* k: [6 C
一个是防错处理方面的。是否要再加上一个步骤,判断输入身份证单元格中的内容是否为纯数字,或纯数字+字母X。# R4 h8 G  N2 }3 X7 z+ M

. E: p+ o! k" f, M7 i9 v6 d" |$ z二是年份处理方面的。我查了下新闻,第二代身份证是2004年开始换发的,而此前好像只有满16岁才能领身份证,那就是说,2000年及以后出生的人,应该是只会领到二代证,不会领到一代证的。那么身份证号为15位,且第7位数是0的情况,所代表的年份,应该还是190X年,而不是200X年。
回复

使用道具 举报

19

主题

106

听众

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 编辑
( m# Z0 O) H- _9 Y6 l
- V! q) G6 ~4 {4 _2 k7 }& t另外补充一下用函数的方法来实现这个需求的方法,关键是使用 TEXT 函数。) J1 J4 ^8 C# ~# {0 q2 p

! V) g( ~  o( b# V6 C0 V& T; W假设输入身份证号码的单元格为 A1,提取年份的单元格为 B1。
1 K9 U% G* Z  e1 @8 S' q% i* ?
- C6 @# X7 N; N/ M; d  |( n1、如果需要的日期格式为: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

主题

59

听众

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官方论坛     

GMT+8, 2017-11-20 08:05

Powered by Discuz! X2.5

© 2001-2012 Comsenz Inc.

回顶部