VBA写代码:写一个针对不规则日期的转换函数

创作原因：接收客户提供过来的不规则日期，转换为代码需求的标准日期。

模版表格为多人填写，导致日期格式存在多样性，如截图：

如果你也喜欢，请帮忙点个爱心，让更多的人学到这么有趣的文章。

是你的认可，给我提供了分享、创作的巨大动力。

明文代码：

Function 日期转换(inputVal As Variant) As String

    On Error GoTo ErrorHandler

    Dim inputStr As String

    inputStr = Trim(CStr(inputVal)) ' 去除首尾空格

    ' 替换非标准分隔符为横杠

    inputStr = Replace(inputStr, ".", "-")

    inputStr = Replace(inputStr, "年", "-")

    inputStr = Replace(inputStr, "月", "-")

    inputStr = Replace(inputStr, "日", "")

    ' 提取所有数字字符，判断是否为纯数字输入

    Dim numStr As String

    numStr = ""

    For i = 1 To Len(inputStr)

        If IsNumeric(Mid(inputStr, i, 1)) Then

            numStr = numStr & Mid(inputStr, i, 1)

        End If

    Next i

    ' 如果输入是纯数字（无任何分隔符），直接进入数字拆分逻辑

    If numStr = inputStr Then

        GoTo ProcessNumericDate

    End If

    ' 非纯数字格式，尝试用CDate转换

    Dim dt As Date

    dt = CDate(inputStr)

    日期转换 = Format(dt, "yyyy/m/d")

    Exit Function

ProcessNumericDate:

    ' 处理纯数字格式（20260115、2026115、202615等）

    Select Case Len(numStr)

        Case 8 ' YYYYMMDD（如20260115）

            Dim y8 As Integer, m8 As Integer, d8 As Integer

            y8 = CInt(Left(numStr, 4))

            m8 = CInt(Mid(numStr, 5, 2))

            d8 = CInt(Right(numStr, 2))

            If IsValidDate(y8, m8, d8) Then

                日期转换 = Format(DateSerial(y8, m8, d8), "yyyy/m/d")

            Else

                日期转换 = "无效日期"

            End If

        Case 7 ' YYYYMDD（如2026115 → 2026年1月15日）

            Dim y7 As Integer, m7 As Integer, d7 As Integer

            y7 = CInt(Left(numStr, 4))

            m7 = CInt(Mid(numStr, 5, 1))

            d7 = CInt(Right(numStr, 2))

            If IsValidDate(y7, m7, d7) Then

                日期转换 = Format(DateSerial(y7, m7, d7), "yyyy/m/d")

            Else

                日期转换 = "无效日期"

            End If

        Case 6 ' YYMMDD（如260115 → 2026年1月15日）

            Dim y6 As Integer, m6 As Integer, d6 As Integer

            y6 = CInt(Left(numStr, 2))

            y6 = IIf(y6 <= 29, 2000 + y6, 1900 + y6) ' 年份判断

            m6 = CInt(Mid(numStr, 3, 2))

            d6 = CInt(Right(numStr, 2))

            If IsValidDate(y6, m6, d6) Then

                日期转换 = Format(DateSerial(y6, m6, d6), "yyyy/m/d")

            Else

                日期转换 = "无效日期"

            End If

        Case 5 ' YYYYMD（如202615 → 2026年1月5日）

            Dim y5 As Integer, m5 As Integer, d5 As Integer

            y5 = CInt(Left(numStr, 4))

            m5 = CInt(Mid(numStr, 5, 1))

            d5 = CInt(Right(numStr, 1))

            If IsValidDate(y5, m5, d5) Then

                日期转换 = Format(DateSerial(y5, m5, d5), "yyyy/m/d")

            Else

                日期转换 = "无效日期"

            End If

        Case Else

            日期转换 = "无效日期"

    End Select

    Exit Function

ErrorHandler:

    ' 非纯数字但CDate转换失败，尝试按数字处理

    GoTo ProcessNumericDate

End Function

' 辅助函数：验证日期合法性

Function IsValidDate(y As Integer, m As Integer, d As Integer) As Boolean

    On Error Resume Next

    Dim temp As Date

    temp = DateSerial(y, m, d)

    IsValidDate = (Err.Number = 0)

    On Error GoTo 0

End Function

格式代码：

Function 日期转换(inputVal As Variant) As String    On Error GoTo ErrorHandler    Dim inputStr As String    inputStr = Trim(CStr(inputVal)) ' 去除首尾空格    ' 替换非标准分隔符为横杠    inputStr = Replace(inputStr, ".", "-")    inputStr = Replace(inputStr, "年", "-")    inputStr = Replace(inputStr, "月", "-")    inputStr = Replace(inputStr, "日", "")    ' 提取所有数字字符，判断是否为纯数字输入    Dim numStr As String    numStr = ""    For i = 1 To Len(inputStr)        If IsNumeric(Mid(inputStr, i, 1)) Then            numStr = numStr & Mid(inputStr, i, 1)        End If    Next i    ' 如果输入是纯数字（无任何分隔符），直接进入数字拆分逻辑    If numStr = inputStr Then        GoTo ProcessNumericDate    End If    ' 非纯数字格式，尝试用CDate转换    Dim dt As Date    dt = CDate(inputStr)    日期转换 = Format(dt, "yyyy/m/d")    Exit FunctionProcessNumericDate:    ' 处理纯数字格式（20260115、2026115、202615等）    Select Case Len(numStr)        Case 8 ' YYYYMMDD（如20260115）            Dim y8 As Integer, m8 As Integer, d8 As Integer            y8 = CInt(Left(numStr, 4))            m8 = CInt(Mid(numStr, 5, 2))            d8 = CInt(Right(numStr, 2))            If IsValidDate(y8, m8, d8) Then                日期转换 = Format(DateSerial(y8, m8, d8), "yyyy/m/d")            Else                日期转换 = "无效日期"            End If        Case 7 ' YYYYMDD（如2026115 → 2026年1月15日）            Dim y7 As Integer, m7 As Integer, d7 As Integer            y7 = CInt(Left(numStr, 4))            m7 = CInt(Mid(numStr, 5, 1))            d7 = CInt(Right(numStr, 2))            If IsValidDate(y7, m7, d7) Then                日期转换 = Format(DateSerial(y7, m7, d7), "yyyy/m/d")            Else                日期转换 = "无效日期"            End If        Case 6 ' YYMMDD（如260115 → 2026年1月15日）            Dim y6 As Integer, m6 As Integer, d6 As Integer            y6 = CInt(Left(numStr, 2))            y6 = IIf(y6 <= 29, 2000 + y6, 1900 + y6) ' 年份判断            m6 = CInt(Mid(numStr, 3, 2))            d6 = CInt(Right(numStr, 2))            If IsValidDate(y6, m6, d6) Then                日期转换 = Format(DateSerial(y6, m6, d6), "yyyy/m/d")            Else                日期转换 = "无效日期"            End If        Case 5 ' YYYYMD（如202615 → 2026年1月5日）            Dim y5 As Integer, m5 As Integer, d5 As Integer            y5 = CInt(Left(numStr, 4))            m5 = CInt(Mid(numStr, 5, 1))            d5 = CInt(Right(numStr, 1))            If IsValidDate(y5, m5, d5) Then                日期转换 = Format(DateSerial(y5, m5, d5), "yyyy/m/d")            Else                日期转换 = "无效日期"            End If        Case Else            日期转换 = "无效日期"    End Select    Exit FunctionErrorHandler:    ' 非纯数字但CDate转换失败，尝试按数字处理    GoTo ProcessNumericDateEnd Function' 辅助函数：验证日期合法性Function IsValidDate(y As Integer, m As Integer, d As Integer) As Boolean    On Error Resume Next    Dim temp As Date    temp = DateSerial(y, m, d)    IsValidDate = (Err.Number = 0)    On Error GoTo 0End Function