看到教材中的一個示例，可從身份證號提取性別、出生年月日、年齡。但是有個問題，即，當僅選擇一個單元格時，會報錯（型別錯誤）。於是，修改了這個問題。

現在，僅選擇一行，也可以進行提取。

程式碼：

Sub extractIDInfo()    '利用VBA從身份證號碼中提取性別、出生日期和年齡
    Dim rng As Range, i As Integer, Mystr As String, arr(), arr2()
    If TypeName(Selection) <> "Range" Then MsgBox "請選擇存放身份證號碼的區域": Exit Sub
    Set rng = Intersect(Selection, ActiveSheet.UsedRange)
    If rng.Columns.Count > 1 Then MsgBox "只能選擇單列", vbOKOnly + vbInformation, "出錯提示": Exit Sub
    If rng(1) = "" Then MsgBox "請選擇身份證號碼存放區域", vbOKOnly + vbInformation, "出錯提示": Exit Sub
    
    ReDim arr(1 To rng.Rows().Count, 1 To 1)
    For i = 1 To rng.Rows().Count
        arr(i, 1) = rng(i).Value
    Next

    ReDim arr2(1 To UBound(arr), 1 To 3)
    For i = 1 To UBound(arr)
        If Len(arr(i, 1)) = 15 Or Len(arr(i, 1)) = 18 Then
            arr2(i, 1) = IIf((Mid(arr(i, 1), 15, 3) Mod 2), "男", "女")
            If Len(arr(i, 1)) = 15 And Mid(arr(i, 1), 7, 1) = 0 Then Mystr = "20" & Mid(arr(i, 1), 7, 2) & "-" & Mid(arr(i, 1), 9, 2) & "-" & Mid(arr(i, 1), 11, 2)
            If Len(arr(i, 1)) = 15 And Mid(arr(i, 1), 7, 1) > 0 Then Mystr = "19" & Mid(arr(i, 1), 7, 2) & "-" & Mid(arr(i, 1), 9, 2) & "-" & Mid(arr(i, 1), 11, 2)
            If Len(arr(i, 1)) = 18 Then Mystr = Mid(arr(i, 1), 7, 4) & "-" & Mid(arr(i, 1), 11, 2) & "-" & Mid(arr(i, 1), 13, 2)
            arr2(i, 2) = Mystr
            arr2(i, 3) = Evaluate("DATEDIF(" & DateSerial(Split(Mystr, "-")(0), Split(Mystr, "-")(1), Split(Mystr, "-")(2)) * 1 & ", NOW()," & """Y""" & ")")
        End If
    Next i
    rng.Offset(0, 1).Resize(UBound(arr), 3) = arr2
End Sub