中文日期转标准日期的一个自定义函数

时　间:2024-08-06 00:02:58
作　者:张志   ID：8  城市：上海  QQ：2851379730
摘　要:由于获得的数据是中文日期，需要将其转为标准日期格式，故写了一个自定义函数来实现。
正　文:

      因工作需要，需要将中文的日期格式（例如 二零二四年二月二十八日），转化为标准日期格式（2024-02-28），以方便对数据进行按年、月、日统计。

      写了一个自定义函数来实现，具体代码如下：

Function StandardDate(strCn As String) As Date
    On Error Resume Next
    '来源：www.accessoft.com
    '作者：张志
    '日期：2024-8-6
    '中文日期年份必须是4位，月和日必须正确
    '对于 壹贰叁这类文字没有去处理，若需要处理这类文字，可自行加相关代码。
    Dim i As Integer
    Dim x As Integer
    Dim CnToDate As String
    Dim strWord As String
    Dim m As Integer
    Dim n As Integer
    Dim z As Integer
    Dim k As Integer
    
    CnToDate = ""
    StandardDate = #1/1/1900#
    '如果第5位不是 年 字，就退出函数，出错了，直接设置为#1/1/1900#
    If Mid(strCn, 5, 1) <> "年" Then Exit Function
    '处理年
    For i = 1 To 4
        strWord = Mid(strCn, i, 1)
        Select Case strWord
        Case "〇"
            CnToDate = CnToDate & "0"
        Case "零"
            CnToDate = CnToDate & "0"
        Case "一"
            CnToDate = CnToDate & "1"
        Case "二"
            CnToDate = CnToDate & "2"
        Case "三"
            CnToDate = CnToDate & "3"
        Case "四"
            CnToDate = CnToDate & "4"
        Case "五"
            CnToDate = CnToDate & "5"
        Case "六"
            CnToDate = CnToDate & "6"
        Case "七"
            CnToDate = CnToDate & "7"
        Case "八"
            CnToDate = CnToDate & "8"
        Case "九"
            CnToDate = CnToDate & "9"
        End Select
    Next i
    CnToDate = CnToDate & "-"
    '处理月
    m = InStr(strCn, "月")
    z = m - 6 '月份字符数
    
    strWord = Mid(strCn, 6, z)
    Select Case strWord
    Case "一"
        CnToDate = CnToDate & "1"
    Case "二"
        CnToDate = CnToDate & "2"
    Case "三"
        CnToDate = CnToDate & "3"
    Case "四"
        CnToDate = CnToDate & "4"
    Case "五"
        CnToDate = CnToDate & "5"
    Case "六"
        CnToDate = CnToDate & "6"
    Case "七"
        CnToDate = CnToDate & "7"
    Case "八"
        CnToDate = CnToDate & "8"
    Case "九"
        CnToDate = CnToDate & "9"
    Case "十"
        CnToDate = CnToDate & "10"
    Case "十一"
        CnToDate = CnToDate & "11"
    Case "十二"
        CnToDate = CnToDate & "12"
    End Select
    CnToDate = CnToDate & "-"
    '处理日
    n = InStr(strCn, "日")
    k = n - m - 1 '日字符数
    strWord = Mid(strCn, 7 + z, k)
    Select Case strWord
    Case "一"
        CnToDate = CnToDate & "1"
    Case "二"
        CnToDate = CnToDate & "2"
    Case "三"
        CnToDate = CnToDate & "3"
    Case "四"
        CnToDate = CnToDate & "4"
    Case "五"
        CnToDate = CnToDate & "5"
    Case "六"
        CnToDate = CnToDate & "6"
    Case "七"
        CnToDate = CnToDate & "7"
    Case "八"
        CnToDate = CnToDate & "8"
    Case "九"
        CnToDate = CnToDate & "9"
    Case "十"
        CnToDate = CnToDate & "10"
    Case "十一"
        CnToDate = CnToDate & "11"
    Case "十二"
        CnToDate = CnToDate & "12"
    Case "十三"
        CnToDate = CnToDate & "13"
    Case "十四"
        CnToDate = CnToDate & "14"
    Case "十五"
        CnToDate = CnToDate & "15"
    Case "十六"
        CnToDate = CnToDate & "16"
    Case "十七"
        CnToDate = CnToDate & "17"
    Case "十八"
        CnToDate = CnToDate & "18"
    Case "十九"
        CnToDate = CnToDate & "19"
    Case "二十"
        CnToDate = CnToDate & "20"
    Case "二十一"
        CnToDate = CnToDate & "21"
    Case "二十二"
        CnToDate = CnToDate & "22"
    Case "二十三"
        CnToDate = CnToDate & "23"
    Case "二十四"
        CnToDate = CnToDate & "24"
    Case "二十五"
        CnToDate = CnToDate & "25"
    Case "二十六"
        CnToDate = CnToDate & "26"
    Case "二十七"
        CnToDate = CnToDate & "27"
    Case "二十八"
        CnToDate = CnToDate & "28"
    Case "二十九"
        CnToDate = CnToDate & "29"
    Case "三十"
        CnToDate = CnToDate & "30"
    Case "三十一"
        CnToDate = CnToDate & "31"
    End Select
    StandardDate = CDate(CnToDate)
End Function

附   件:

点击下载此附件

图   示: