Function IDCardInfo(单元格 As Variant, Optional 模式1生日2年龄3性别4生肖5星座6有效性 As Integer = 1) As Variant Dim id As String, isValid As Boolean Dim birthDate As Date, age As Integer Dim gender As String, zodiac As String, constellation As String Dim i As Integer, sum As Long Dim weights As Variant, checkCodes As String Dim prefix As String, checkCode As String, calcCheck As String Dim y As String, m As String, d As String Dim zodiacArr As Variant id = CStr(单元格) id = Trim(id) isValid = False weights = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2) checkCodes = "10X98765432" zodiacArr = Array("鼠", "牛", "虎", "兔", "龙", "蛇", "马", "羊", "猴", "鸡", "狗", "猪") If Len(id) = 15 Then ' 15位：全数字验证 If IsNumeric(id) Then y = "19" & Mid(id, 7, 2) m = Mid(id, 9, 2) d = Mid(id, 11, 2) If IsDate(y & "/" & m & "/" & d) Then birthDate = CDate(y & "/" & m & "/" & d) isValid = True gender = IIf(CInt(Mid(id, 15, 1)) Mod 2 = 1, "男", "女") End If End If ElseIf Len(id) = 18 Then ' 18位：前17位数字 + 校验码验证 prefix = Left(id, 17) checkCode = UCase(Right(id, 1)) If IsNumeric(prefix) And (checkCode Like "[0-9]" Or checkCode = "X") Then sum = 0 For i = 1 To 17 sum = sum + CInt(Mid(prefix, i, 1)) * weights(i - 1) Next i calcCheck = Mid(checkCodes, (sum Mod 11) + 1, 1) If checkCode = calcCheck Then y = Mid(id, 7, 4) m = Mid(id, 11, 2) d = Mid(id, 13, 2) If IsDate(y & "/" & m & "/" & d) Then birthDate = CDate(y & "/" & m & "/" & d) isValid = True gender = IIf(CInt(Mid(id, 17, 1)) Mod 2 = 1, "男", "女") End If End If End If End If ' 无效时返回 If Not isValid Then If 模式1生日2年龄3性别4生肖5星座6有效性 = 6 Then IDCardInfo = "无效" Else IDCardInfo = "身份证无效" End If Exit Function End If ' 年龄（周岁） age = Year(Date) - Year(birthDate) If Month(Date) < Month(birthDate) Or (Month(Date) = Month(birthDate) And Day(Date) < Day(birthDate)) Then age = age - 1 End If ' 生肖 zodiac = zodiacArr((Year(birthDate) - 1900) Mod 12) ' 星座 Select Case Month(birthDate) Case 1 constellation = IIf(Day(birthDate) >= 20, "水瓶座", "摩羯座") Case 2 constellation = IIf(Day(birthDate) >= 19, "双鱼座", "水瓶座") Case 3 constellation = IIf(Day(birthDate) >= 21, "白羊座", "双鱼座") Case 4 constellation = IIf(Day(birthDate) >= 20, "金牛座", "白羊座") Case 5 constellation = IIf(Day(birthDate) >= 21, "双子座", "金牛座") Case 6 constellation = IIf(Day(birthDate) >= 22, "巨蟹座", "双子座") Case 7 constellation = IIf(Day(birthDate) >= 23, "狮子座", "巨蟹座") Case 8 constellation = IIf(Day(birthDate) >= 23, "处女座", "狮子座") Case 9 constellation = IIf(Day(birthDate) >= 23, "天秤座", "处女座") Case 10 constellation = IIf(Day(birthDate) >= 24, "天蝎座", "天秤座") Case 11 constellation = IIf(Day(birthDate) >= 23, "射手座", "天蝎座") Case 12 constellation = IIf(Day(birthDate) >= 22, "摩羯座", "射手座") End Select '返回结果 Select Case 模式1生日2年龄3性别4生肖5星座6有效性 Case 1 IDCardInfo = Format(birthDate, "yyyy-mm-dd") Case 2 IDCardInfo = age Case 3 IDCardInfo = gender Case 4 IDCardInfo = zodiac Case 5 IDCardInfo = constellation Case 6 IDCardInfo = "有效" Case Else IDCardInfo = "身份证无效" End SelectEnd Function
