005-身份证号码的拆分

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

005-身份证号码的拆分

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

005-身份证号码的拆分

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

005-身份证号码的拆分

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

Sub 身份证分解()

Dim rng As Range

Dim str As String

Application.ScreenUpdating = False

For 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 If

Next

Application.ScreenUpdating = True

End Sub

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

005-身份证号码的拆分

Sub 金额分解()

Dim rng As Range

Dim str As String

Application.ScreenUpdating = False

For 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 If

Next

Application.ScreenUpdating = True

End Sub

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

005-身份证号码的拆分

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

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