看到教材中的一个示例，可从身份证号提取性别、出生年月日、年龄。但是有个问题，即，当仅选择一个单元格时，会报错（类型错误）。于是，修改了这个问题。
现在，仅选择一行，也可以进行提取。
代码：
Sub extractIDInfo() '利用VBA从身份证号码中提取性别、出生日期和年龄Dim rng As Range, i As Integer, Mystr As String, arr(), arr2()If TypeName(Selection) <> "Range" Then MsgBox "请选择存放身份证号码的区域": Exit SubSet rng = Intersect(Selection, ActiveSheet.UsedRange)If rng.Columns.Count > 1 Then MsgBox "只能选择单列", vbOKOnly + vbInformation, "出错提示": Exit SubIf rng(1) = "" Then MsgBox "请选择身份证号码存放区域", vbOKOnly + vbInformation, "出错提示": Exit SubReDim arr(1 To rng.Rows().Count, 1 To 1)For i = 1 To rng.Rows().Countarr(i, 1) = rng(i).ValueNextReDim 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 Thenarr2(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) = Mystrarr2(i, 3) = Evaluate("DATEDIF(" & DateSerial(Split(Mystr, "-")(0), Split(Mystr, "-")(1), Split(Mystr, "-")(2)) * 1 & ", NOW()," & """Y""" & ")")End IfNext irng.Offset(0, 1).Resize(UBound(arr), 3) = arr2End Sub
