定制VBA之提取身份证出生日期

1、如下图含有部分身份证号码，现在我们想要使用VBA快速提取出这些身份证号码中的出生日期。

2、同时按下Alt+F11打开VBA编辑窗口

3、点击sheet1，然后在右边区域输入VBA代码。（详细代码在最后一步）

4、返回Excel界面，选中A2:A11单元格区域

5、然后在VBA界面点击F5，选择运行，然后选择B2单元格，点击确定

6、即可批量提取出生日期，完成效果如下图。

7、本文中使用的VBA代码如下，如果有朋友需要定制VBA,可以百度方方格子。

Sub ???????????????()

 

        On Error Resume Next

 

    Dim ar, i, ii

 

    Dim tmp

 

   

 

    If Selection.Areas.Count > 1 Then Exit Sub

 

    If Selection.Cells.Count > Columns.Count Then

 

        MsgBox "?????????????"

 

        Exit Sub

 

    End If

    ar = Selection

 

    Set rngs = Application.InputBox("???????????????", "???", , , , , , 8)

 

   

 

    '????????

 

    If Selection.Cells.Count = 1 Then

 

        tmp = IDBirthday(ar)

 

        ar = tmp

 

       

 

        rngs.Cells(1, 1) = ar

 

        Exit Sub

 

    End If

 

   

 

    '????????

 

    Randomize Timer

 

    For i = 1 To UBound(ar)

 

        For ii = 1 To UBound(ar, 2)

 

            tmp = IDBirthday(ar(i, ii))

 

            ar(i, ii) = tmp

 

        Next

 

    Next

 

    rngs.Resize(UBound(ar), UBound(ar, 2)) = ar

 

End Sub

Function IDBirthday(sid) As String

 

    Dim rlt

    Select Case Len(sid)

 

        Case 15

 

            rlt = Format("19" & Mid(sid, 7, 6), "0000-00-00")

 

        Case 18

 

            rlt = Format(Mid(sid, 7, 8), "0000-00-00")

 

        Case 0

 

            rlt = ""

 

        Case Else

 

            rlt = "??Ч"

 

    End Select

    IDBirthday = rlt

 

End Function