漢数字で書かれた日付を、日付データとして認識してみる

昨日は、漢数字を数値として認識してみた。
infoment.hatenablog.com

今日はこの機能を利用して、漢数字で書かれた日付を、日付データとして認識することに挑戦する。
f:id:Infoment:20190703220457p:plain

今回は日付の表記ということで、条件をかなり限定した。

「年」は西暦とする。
「年」に含まれる「0」は「〇」で表記する。
「年」は、「千」「百」「十」は用いず、漢数字を４つ並べて表現する。
例）2019年 ⇒ 二〇一九年
「月」「日」の10の位は「十」を用いて表記する。
「年」「月」「日」の順に記載する。

これらの約束事守ると、難しさは激減する。今回は、「正規表現」を用いてみた。

まず昨日も登場した、漢数字をアラビア数字に変換するユーザー定義関数を再掲。

Function ChineseToArabicNumerals(str As String) As Long
    Dim Sorce As String
        Sorce = "一二三四五六七八九〇"
    Dim Destination As String
        Destination = "1234567890"
    
    ' まず単純に置換する。
    Dim i As Long
        For i = 1 To 10
            str = Replace(str, _
                        Mid(Sorce, i, 1), _
                        Mid(Destination, i, 1))
        Next
    
    ' 文字数から判別して、「十」を「10」に置き換える。
    Select Case Len(str)
        Case 1
            If str = "十" Then str = 10
        Case 2
            If Right(str, 1) = "十" Then
                str = Left(str, 1) * 10
            Else
                str = 10 + Right(str, 1)
            End If
        Case 3
            str = Left(str, 1) * 10 + Right(str, 1)
    End Select
    ChineseToArabicNumerals = str
End Function

次いで、日付変換用のユーザー定義関数がこちら。

Function ToDate(str As String) As Date
    ' Microsoft VBScript Regular Expressions 5.5 参照済み。
    Dim myReg As RegExp
    Set myReg = New RegExp
        ' １～４文字（英数字以外）の後に「年」「月」「日」のいずれか１文字が登場するというパターン。
        myReg.Pattern = "(\W{1,4}?)[年月日]"
        ' ある限り探し続ける。
        myReg.Global = True
        
    Dim MC As MatchCollection
    Dim SM As SubMatches
    Dim i As Long
    Dim arr(2) As Variant
    If myReg.Test(str) Then
        Set MC = myReg.Execute(str)
        ' パターンにマッチしたものを、一つずつ「年」「月」「日」
        ' として配列に格納する。
        For i = 0 To MC.Count - 1
            Set SM = MC(i).SubMatches
            arr(i) = ChineseToArabicNumerals(SM(0))
        Next
    End If
    
    ' 取得した年月日を用いて、日付データに変換する。
    ToDate = DateSerial(arr(0), arr(1), arr(2))
End Function