[vba/excel]文字列中の数字を漢数字に置き換える

gistfile1.vb

Public Sub sample()
    Const strExample As String = "今日は1月12日です。"
    Debug.Print ConvertNumbersToKanSuji(strExample)
End Sub


'-------------------------------------------------------------------------------
'文字列中の数字を漢数字に置き換える
'-------------------------------------------------------------------------------
'【引数】文字列
'【戻り値】数字を漢数字に置き換えた文字列
'【備考】日付を変換することを想定しているため「百五十二」のような形式に変換する。
Private Function ConvertNumbersToKanSuji(strInputed As String) As String
    Const strPattern = "[0-9]+"
    Dim strTarget As String
    Dim RE As Object
    Dim objMatches As Object
    Dim i As Long
    Dim z As Long
    Dim strNumber As String
    Dim strKanSuji As String
    
    If strInputed = "" Then
        Exit Function
    Else
        strTarget = strInputed
    End If
    
    Set RE = CreateObject("VBScript.RegExp")
    With RE
        .Pattern = strPattern
        .Global = True
        Set objMatches = .Execute(strTarget)
    End With
    
    RE.Global = False
    If objMatches.Count > 0 Then
        z = objMatches.Count - 1
        For i = 0 To z
            strNumber = objMatches(i).Value
            strKanSuji = GetKanSujiNumber(strNumber)
            With RE
                .Pattern = strNumber
                strTarget = .Replace(strTarget, strKanSuji)
            End With
        Next i
    End If
    Set objMatches = Nothing
    Set RE = Nothing
    
    ConvertNumbersToKanSuji = strTarget
End Function


'-------------------------------------------------------------------------------
'数字の文字列を漢数字の文字列に変換する
'-------------------------------------------------------------------------------
'【引数】数字の文字列、（NumberString関数のオプション（1,2,3））
'【戻り値】漢数字の文字列
'【備考】引数intOptionが渡されない場合は1とする。
'        オプションによる違いは以下の通り（"152"の例）
'        1：百五十二
'        2：壱百伍拾弐
'        3：一五二
Private Function GetKanSujiNumber(strNumber As String, Optional intOption As Variant) As String
    Dim strFormula As String
    
    If IsMissing(intOption) Then
        intOption = 1
    ElseIf intOption < 1 Or intOption > 3 Then
        Exit Function
    End If

    strFormula = "=NumberString(" & strNumber & ", " & CStr(intOption) & ")"
    
    GetKanSujiNumber = Evaluate(strFormula)
End Function