VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板

　　　　　サンプル投稿用掲示板　　 VB2005 ～用トップページ　　 VB6.0 用トップページ

数値を漢数字に変換する(VB6.0) ( No.0 ) 　[親スレッドへ]

日時： 2009/12/27 11:36
名前： 花ちゃん: ***********************************************************************************
* カテゴリー：[文字列処理][アルゴリズム][応用コード]                              *
* キーワード：文字列変換,漢数字,一十百,縦書き,自作関数,アラビア数字←→漢数字     *
***********************************************************************************

--------------------------------------------------------------------------------
No.662 RE:数値を漢字に変換するには？　　投稿者：MOO [1999/08/24(火)12：19分]
--------------------------------------------------------------------------------

久しぶりだ。
------------------------------------
次のような関数を作成してみました。

標準モジュールに組み込んで
    nStr1 = toKanji(10)
    nStr2 = toKanji(20)
と呼び出せば
    nStr1は"十"，nStr2は"二十"
となります。

Public Function toKanji(Value As Long) As String

    Dim vStr As String
    Dim sCnt As Integer
    Dim Char As String
    Dim tempStr As String

    If Value = 0 Then
        toKanji = "零"
        Exit Function
    End If

    If Value < 0 Then
        tempStr = "マイナス"
        vStr = CStr(Abs(Value))
    Else
        vStr = CStr(Value)
    End If

    sCnt = Len(vStr)
    vStr = Space(10 - sCnt) & vStr

    Char = Left$(vStr, 1)
    If Char <> " " Then
        If Char = "1" Then
            tempStr = tempStr & "十"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "十"
        End If
    End If

    Char = Mid$(vStr, 2, 1)
    If Char <> " " Then
        If Char = "0" Then
            tempStr = tempStr & "億"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "億"
        End If
    End If

    Char = Mid$(vStr, 3, 1)
    If Char <> " " And Char <> "0" Then
        If Char = "1" Then
            tempStr = tempStr & "千"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "千"
        End If
    End If

    Char = Mid$(vStr, 4, 1)
    If Char <> " " And Char <> "0" Then
        If Char = "1" Then
            tempStr = tempStr & "百"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "百"
        End If
    End If

    Char = Mid$(vStr, 5, 1)
    If Char <> " " And Char <> "0" Then
        If Char = "1" Then
            tempStr = tempStr & "十"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "十"
        End If
    End If

    Char = Mid$(vStr, 6, 1)
    If Char <> " " Then
        If Char = "0" Then
            tempStr = tempStr & "万"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "万"
        End If
    End If

    Char = Mid$(vStr, 7, 1)
    If Char <> " " And Char <> "0" Then
        If Char = "1" Then
            tempStr = tempStr & "千"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "千"
        End If
    End If

    Char = Mid$(vStr, 8, 1)
    If Char <> " " And Char <> "0" Then
        If Char = "1" Then
            tempStr = tempStr & "百"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "百"
        End If
    End If

    Char = Mid$(vStr, 9, 1)
    If Char <> " " And Char <> "0" Then
        If Char = "1" Then
            tempStr = tempStr & "十"
        Else
            tempStr = tempStr & toKanjiSub(Char) & "十"
        End If
    End If

    Char = Right$(vStr, 1)
    If Char <> " " And Char <> "0" Then
        tempStr = tempStr & toKanjiSub(Char)
    End If

    toKanji = tempStr

End Function

Private Function toKanjiSub(nStr As String) As String

    Select Case nStr
        Case "1"
            toKanjiSub = "一"
        Case "2"
            toKanjiSub = "二"
        Case "3"
            toKanjiSub = "三"
        Case "4"
            toKanjiSub = "四"
        Case "5"
            toKanjiSub = "五"
        Case "6"
            toKanjiSub = "六"
        Case "7"
            toKanjiSub = "七"
        Case "8"
            toKanjiSub = "八"
        Case "9"
            toKanjiSub = "九"
        Case Else
            toKanjiSub = ""
    End Select

End Function