#VBA #EXCEL技巧 #自定义函数

第一篇：初识UDF & 身份证信息提取器

你用过Excel公式吧？SUM、VLOOKUP、IF……但有时候你会遇到一个尴尬的场景：Excel没有现成的公式能满足你的需求。

比如：

• • 提取身份证号里的出生日期和性别
• • 根据IP地址判断归属地
• • 计算两个日期之间的工作日（排除节假日）

用一堆公式嵌套？能实现，但写出来像天书，三个月后自己都看不懂。

自定义函数（UDF，User-Defined Function）就是解决这个问题的。

你用VBA写一个函数，然后在Excel里像用SUM一样直接用。

什么是UDF？

简单说：你写的函数，Excel原生函数一样用。

普通VBA宏（Sub）需要在VBA编辑器里运行，或者绑到按钮上。而UDF（Function）可以直接在单元格的公式栏里输入。

对比一下：

代码长这样：

' 写在普通模块里（不是Sheet模块，不是ThisWorkbook）Function 你想要的函数名(参数1 As 类型, 参数2 As 类型) As 返回类型    ' 你的计算逻辑    你想要的函数名 = 计算结果End Function

然后你在Excel单元格里就可以这样用：

=你想要的函数名(A1,B1)

就这么简单。

案例一：身份证信息提取器

中国身份证号是18位，里面藏着 出生日期、性别、年龄、归属地代码 等信息。Excel没有能直接提取这些的函数，但写一个UDF只需要几分钟。

写法

Option Explicit' ========== 主函数 ==========Public Function IDCardInfo(idCard As String, infoType As String) As Variant    ' 1. 清理空格    idCard = Replace(idCard, " ", "")    idCard = Replace(idCard, vbTab, "")    ' 2. 长度校验    If Len(idCard) = 15 Then        idCard = Convert15To18(idCard)        If idCard = "" Then            IDCardInfo = "无效的15位身份证号"            Exit Function        End If    ElseIf Len(idCard) <> 18 Then        IDCardInfo = "身份证号必须是15位或18位"        Exit Function    End If    ' 3. 校验码验证（18位）    If Not ValidateIDCard18(idCard) Then        IDCardInfo = "无效的身份证号（校验码错误）"        Exit Function    End If    ' 4. 提取出生日期    Dim birthYear As Integer, birthMonth As Integer, birthDay As Integer    Dim birthDate As Date    On Error GoTo DateError    birthYear = CInt(Mid(idCard, 7, 4))    birthMonth = CInt(Mid(idCard, 11, 2))    birthDay = CInt(Mid(idCard, 13, 2))    birthDate = DateSerial(birthYear, birthMonth, birthDay)    On Error GoTo 0    ' 5. 性别（第17位奇偶）    Dim gender As String    gender = IIf(CInt(Mid(idCard, 17, 1)) Mod 2 = 1, "男", "女")    ' 6. 根据请求类型返回    Select Case LCase(Trim(infoType))        Case "生日", "出生日期", "birth"            IDCardInfo = Format(birthDate, "yyyy-mm-dd")        Case "年龄", "age"            IDCardInfo = GetAge(birthDate)        Case "性别", "gender"            IDCardInfo = gender        Case "星座", "constellation"            IDCardInfo = GetConstellation(birthMonth, birthDay)        Case Else            IDCardInfo = "不支持的类型，请用：生日/年龄/性别/星座"    End Select    Exit FunctionDateError:    IDCardInfo = "出生日期无效"End Function' ========== 18位校验码验证 ==========Private Function ValidateIDCard18(id As String) As Boolean    ' 加权因子    Dim weights As Variant    weights = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)    ' 校验码对应字符    Dim checkCodes As Variant    checkCodes = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")    Dim i As Integer, sum As Integer    For i = 1 To 17        sum = sum + CInt(Mid(id, i, 1)) * weights(i - 1)    Next i    Dim expected As String    expected = checkCodes(sum Mod 11)    ValidateIDCard18 = (UCase(Right(id, 1)) = expected)End Function' ========== 15位转18位（严格按国标计算校验码） ==========Private Function Convert15To18(id15 As String) As String    If Len(id15) <> 15 Then        Convert15To18 = ""        Exit Function    End If    ' 1. 插入"19"变成17位    Dim id17 As String    id17 = Left(id15, 6) & "19" & Mid(id15, 7, 9)    ' 2. 计算校验码    Dim weights As Variant    weights = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)    Dim checkCodes As Variant    checkCodes = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")    Dim i As Integer, sum As Integer    For i = 1 To 17        sum = sum + CInt(Mid(id17, i, 1)) * weights(i - 1)    Next i    Dim checkBit As String    checkBit = checkCodes(sum Mod 11)    Convert15To18 = id17 & checkBitEnd Function' ========== 年龄计算（正确处理闰年2月29日） ==========Private Function GetAge(birthDate As Date) As Integer    Dim today As Date    today = Date    Dim age As Integer    age = year(today) - year(birthDate)    ' 如果今年的生日还没过，年龄减1    If Month(today) < Month(birthDate) Or _       (Month(today) = Month(birthDate) And Day(today) < Day(birthDate)) Then        age = age - 1    End If    GetAge = ageEnd Function' ========== 星座（使用清晰的边界表） ==========Private Function GetConstellation(m As Integer, d As Integer) As String    Select Case m        Case 1:  If d < 20 Then GetConstellation = "摩羯座" Else GetConstellation = "水瓶座"        Case 2:  If d < 19 Then GetConstellation = "水瓶座" Else GetConstellation = "双鱼座"        Case 3:  If d < 21 Then GetConstellation = "双鱼座" Else GetConstellation = "白羊座"        Case 4:  If d < 20 Then GetConstellation = "白羊座" Else GetConstellation = "金牛座"        Case 5:  If d < 21 Then GetConstellation = "金牛座" Else GetConstellation = "双子座"        Case 6:  If d < 22 Then GetConstellation = "双子座" Else GetConstellation = "巨蟹座"        Case 7:  If d < 23 Then GetConstellation = "巨蟹座" Else GetConstellation = "狮子座"        Case 8:  If d < 23 Then GetConstellation = "狮子座" Else GetConstellation = "处女座"        Case 9:  If d < 23 Then GetConstellation = "处女座" Else GetConstellation = "天秤座"        Case 10: If d < 24 Then GetConstellation = "天秤座" Else GetConstellation = "天蝎座"        Case 11: If d < 23 Then GetConstellation = "天蝎座" Else GetConstellation = "射手座"        Case 12: If d < 22 Then GetConstellation = "射手座" Else GetConstellation = "摩羯座"        Case Else: GetConstellation = "未知"    End SelectEnd Function

一个函数解决身份证的所有信息提取。 比Excel那一堆MID+IF嵌套清爽一万倍。

下一篇预告： 中文金额大写转换 —— 财务报表、合同、发票金额大写，一个公式全搞定。