005-身份证号码的拆分

前几天帮别人做了一张表,当时有个问题如下图,要将身份证号码拆分到后面的每个单元格里。 当时也没多想,看着这么规律

005-身份证号码的拆分

前几天帮别人做了一张表,当时有个问题如下图,要将身份证号码拆分到后面的每个单元格里。 005-身份证号码的拆分

当时也没多想,看着这么规律的数字,于是就用了一个简单的函数搞定了。

005-身份证号码的拆分

事后想了想,觉得函数可能有些慢,再加上最近有些忙,导致这个专栏的教程好久没有更新了。于是就想着把这个的做法写下了作为一期。代码如下:

Sub 身份证分解()Dim rng As RangeDim str As StringApplication.ScreenUpdating = FalseFor Each rng In Application.Intersect(Selection, ActiveSheet.UsedRange) If Len(rng) > 0 Then str = StrReverse(rng.Value) For Item = 1 To 18 With rng.Offset(0, 19 - Item) .Value = Mid(str, Item, 1) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End With Next End IfNextApplication.ScreenUpdating = TrueEnd Sub

事后又想一想,发现这段代码稍作修改就可以有更多的用法,比如在财务上的金额需要分解开来。

005-身份证号码的拆分
Sub 金额分解()Dim rng As RangeDim str As StringApplication.ScreenUpdating = FalseFor Each rng In Application.Intersect(Selection, ActiveSheet.UsedRange) If Len(rng) > 0 Then str = StrReverse(Format(rng.Value * 100, "0")) For Item = 1 To 11 with rng.Offset(0, 12 - Item) .Value = Mid(str, Item, 1) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter End with If Item = Len(str) + 1 Then rng.Offset(0, 12 - Item).Value = "¥" End If Next End IfNextApplication.ScreenUpdating = TrueEnd Sub

选中,运行,结果马上就出现了。

005-身份证号码的拆分

把写好的代码做成加载宏存放到Excel里,以后这些问题就可以轻轻松松一键搞定。

未登录用户
全部评论0
到底啦