iso tank

漢数字を半角英数字に変換

<2019-09-22 修正あり>

洋々亭にて、様々なVBAコードが公開されている。(2回目)

前回に引き続き、漢数字を半角英数字に変換する関数(conv2num・subconv2num)を、拡張できるようにしつつパフォーマンス改善を試みた。「一億二千三百四十五万六千七百八十九」を「123456789」とか「123,456,789」とか「1億2345万6789」とかに変換する関数。

Option Explicit

Private Const KAN_NUM As String = "一二三四五六七八九"
Private Const KAN_DEC As String = "十百千"              '十進
Private Const KAN_MYR As String = "万億兆京垓"          '万進
Private Const KAN_COM As String = "、,"                '漢数字の桁区切り

'---------------------------------------------------------------------------------------------------
' 漢数字変換関数
' ◆機能の説明
'  ・漢数字(文字列型)を半角英数字の文字列に変換して返す。
' オプション
'   insertsMyriad      :Trueにすると変換結果に万進(漢字)を挿入する(例:13000→1万3000)
'                        insertsComma(カンマ挿入)と併用可(例:13000→1万3,000)
'   insertsComma       :Trueにすると変換結果にカンマを挿入する(例:13000→13,000)
' 注意:渡す文字列に漢数字以外の文字を含めないこと(旧字体等も不可)
'       ※漢数字以外の文字が含まれていた場合はすべて「0」に変換されるため正常な結果が返せない
' オリジナル:洋々亭 2010(conv2num関数)
'---------------------------------------------------------------------------------------------------
Private Function KanjiToNum(ByVal srcKanji As String, _
                            Optional ByRef insertsMyriad As Boolean = False, _
                            Optional ByRef insertsComma As Boolean = False) As String
    
    Dim queAsc As String    'キュー(半角英数に変換した文字列)
    Dim bufAsc As String    'バッファ
    Dim tmpAsc As String    '一時変数(切り取りや変換を行った文字列)
    Dim tmpNum As Long      '一時変数(文字列を数値化したものや文字数など)
    Dim strLen As Long      '変換・整形元の文字列長
    Dim bufLen As Long      'バッファサイズ(文字列長)
    Dim maxMyr As Long      '定数で定義されている万進(万・億・兆…)の桁数
    Dim cnvFrom As Long     '変換・整形範囲(From)
    Dim cnvTo As Long       '変換・整形範囲(To)
    Dim ptr As Long         '変換後の文字列型変数内のポインタ
    Dim i As Long           'イテレータ
    
    Let strLen = Len(srcKanji)
    If strLen = 0 Then
        Exit Function
    End If
    
    '前処理
    If srcKanji Like "*[" & KAN_COM & "]*" Then
        For i = 1 To Len(KAN_COM)
            Let srcKanji = Replace(srcKanji, Mid$(KAN_COM, i, 1), "")
        Next i
        Let strLen = Len(srcKanji)
    End If
    Let maxMyr = Len(KAN_MYR)
    Let bufLen = maxMyr * 7     'バッファサイズ=定数の万進数×7(必要に応じ見直すこと)
    If bufLen < strLen Then
        Let bufLen = strLen     '引数の文字数の方が多ければそれをバッファサイズとする
    End If
    Let bufAsc = String$(bufLen, vbNullChar)
    
    '漢数字変換フェーズ
    If srcKanji Like "*[" & KAN_MYR & "]*" Then '万進(万・億・兆・京…)を含む漢数字の変換
        For i = maxMyr To 1 Step -1
            If srcKanji Like "*" & Mid$(KAN_MYR, i, 1) & "*" Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = CLng(InStr(cnvFrom, srcKanji, Mid$(KAN_MYR, i, 1)))
                If cnvFrom = 1 Then             '初回処理
                    Call KanToNum(Mid$(srcKanji, cnvFrom, cnvTo - cnvFrom), bufAsc, ptr)
                Else                            '2回目以降の処理(4桁固定、0埋め)
                    Call KanToNum(Mid$(srcKanji, cnvFrom, cnvTo - cnvFrom), bufAsc, ptr, 4)
                End If
            ElseIf cnvFrom > 0 Then
                Mid(bufAsc, ptr) = "0000"       '万進がなくとも変換済みの数字があれば万倍する
                Let ptr = ptr + 4
            End If
        Next i
        If cnvTo < strLen Then                  '未処理の漢数字(1万未満)を変換(4桁が前提)
            Call KanToNum(Mid$(srcKanji, cnvTo + 1), bufAsc, ptr, 4)
        Else
            Mid(bufAsc, ptr) = "0000"           'すべて変換済みでも変換結果を万倍する
            Let ptr = ptr + 4
        End If
    Else
        Call KanToNum(srcKanji, bufAsc, ptr)    '単純変換(万進が使われていない場合)
    End If
    Let queAsc = Left$(bufAsc, ptr)             'トリミングして完成
    Let strLen = Len(queAsc)
    
    '英数字整形フェーズ
    If insertsMyriad And (strLen > 4) Then      '万・億・兆…を含む英数字への整形
        Let ptr = 0
        Let cnvTo = 0
        For i = maxMyr To 0 Step -1
            If strLen > (4 * i) Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = strLen - 4 * i
                Let tmpNum = CLng(Mid$(queAsc, cnvFrom, cnvTo - cnvFrom + 1))
                If tmpNum > 0 Then
                    Let tmpAsc = CStr(tmpNum)   '文字列を数値化→文字列化し、0をトリミング
                    If insertsComma And (tmpNum >= 1000) Then   'カンマ区切り化(再結合)
                        Mid(bufAsc, ptr + 1) = Left$(tmpAsc, 1)
                        Mid(bufAsc, ptr + 2) = ","
                        Mid(bufAsc, ptr + 3) = Mid$(tmpAsc, 2)
                        Let ptr = ptr + 6
                    Else
                        Mid(bufAsc, ptr + 1) = tmpAsc   'カンマ区切りをしない場合は単純結合
                        Let ptr = ptr + Len(tmpAsc) + 1
                    End If
                    If i > 0 Then
                        Mid(bufAsc, ptr) = Mid$(KAN_MYR, i, 1)  '万・億・兆…を末尾に結合
                    Else
                        Let ptr = ptr - 1
                    End If
                End If
            End If
        Next i
        Let KanjiToNum = Left$(bufAsc, ptr)
    ElseIf insertsComma And (strLen > 3) Then   'カンマ区切りを含めた整形
        Let tmpNum = Int((strLen - 1) / 3)      '挿入するカンマの数
        Let KanjiToNum = String$(strLen + tmpNum, vbNullChar)
        Let cnvTo = strLen - tmpNum * 3
        Mid(KanjiToNum, 1) = Left$(queAsc, cnvTo)
        Let ptr = cnvTo + 1
        For i = ptr To strLen - 2 Step 3
            Mid(KanjiToNum, ptr) = ","
            Mid(KanjiToNum, ptr + 1) = Mid$(queAsc, i, 3)
            Let ptr = ptr + 4
        Next i
    Else
        Let KanjiToNum = queAsc                 '単純コピー(整形しない場合)
    End If
End Function

'---------------------------------------------------------------------------------------------------
' 漢数字(十進まで)変換プロシージャ
' ◆機能の説明
'  ・漢数字を半角英数字に変換し、dstAsciiに追記(上書き)する
'  ・endPosに変数を指定した場合、endPosを上書きする(変換後の文字列の終端位置を格納)
' 引数
'   srcKanji:変換元となる漢数字(Source Kanji)
'             ※〇~九・十・百・千の漢数字のみ。万・億・兆…などは受け付けないので注意
'   dstAscii:変換結果(半角英数字)を格納する文字列型変数(Destination ASCII)
'   endPos  :dstAsciiに文字列が既にある場合の、文字列の終端位置(End Position)
'             ※例:dstAsciiに「1万____」が格納されており3文字目以降を上書きしたい場合は「2」と指定
'             ※変換後の文字列を最後にトリミングする必要があるような場合は、変数を指定すること
'   fixLen  :固定したい桁数(Fix Length)
'             ※1以上の数値を指定した場合、その桁数分の範囲内で0埋めを行う(切り詰めは行わない)
'               例:srcKanjiが「二十四」でfixLenが「4」の場合、変換結果は「0024」
' 前提:渡された文字列には、「〇~九・十・百・千」の漢数字しか含まれていない(万進・旧字体等も不可)
'       ※上記数字以外の文字が含まれていた場合はすべて「0」に変換されるため正常な結果が返せない
' オリジナル:洋々亭 2010(subconv2num関数)
'---------------------------------------------------------------------------------------------------
Private Sub KanToNum(ByRef srcKanji As String, _
                     ByRef dstAscii As String, _
                     Optional ByRef endPos As Long = 0, _
                     Optional ByRef fixLen As Long = 0)
    
    Dim srcLen As Long  '変換元(漢数字)の文字列長
    Dim cnvFrom As Long '変換範囲のポインタ(From)
    Dim cnvTo As Long   '変換範囲のポインタ(To)
    Dim szLen As Long   'ゼロ埋めの長さ
    Dim i&, j&          'イテレータ(&はLong型の型宣言文字)
    
    Let srcLen = Len(srcKanji)
    If srcKanji Like "*[" & KAN_DEC & "]*" Then     '十進(十・百・千)の字を含む漢数字の変換
        For i = Len(KAN_DEC) To 1 Step -1           '千の位~十の位まで処理(一の位は処理しない)
            If srcKanji Like "*" & Mid$(KAN_DEC, i, 1) & "*" Then
                Let cnvFrom = cnvTo + 1
                Let cnvTo = CLng(InStr(cnvFrom, srcKanji, Mid$(KAN_DEC, i, 1)))
                If cnvFrom = 1 Then
                    If (fixLen - 1) > i Then
                        Let szLen = fixLen - i - 1
                        Mid(dstAscii, endPos + 1) = String$(szLen, "0")
                        Let endPos = endPos + szLen
                    End If
                End If
                If cnvFrom < cnvTo Then             '十進の左の漢数字を抽出・変換(例:四五千→45)
                    For j = cnvFrom To cnvTo - 1    'InStr探索(一~九→1~9 それ以外→KAN_NUMにないので0)
                        Let endPos = endPos + 1
                        Mid(dstAscii, endPos) = CStr(InStr(KAN_NUM, Mid$(srcKanji, j, 1)))
                    Next j
                Else
                    Let endPos = endPos + 1
                    Mid(dstAscii, endPos) = "1"     '十進の左に漢数字がない場合は1(例:千→1)
                End If
            ElseIf cnvFrom > 0 Then
                Let endPos = endPos + 1
                Mid(dstAscii, endPos) = "0"         '十進がなくとも変換済みの数字があれば10倍する
            End If
        Next i
    Else
        If srcLen < fixLen Then
            Let szLen = fixLen - srcLen
            Mid(dstAscii, endPos + 1) = String$(szLen, "0")
            Let endPos = endPos + szLen
        End If
    End If
    If cnvTo < srcLen Then                          '未処理の漢数字を変換
        For i = cnvTo + 1 To srcLen                 '(十進を含む文字列の一の位 or 十進を含まない文字列の全部)
            Let endPos = endPos + 1
            Mid(dstAscii, endPos) = CStr(InStr(KAN_NUM, Mid$(srcKanji, i, 1)))
        Next i
    ElseIf cnvFrom > 0 Then
        Let endPos = endPos + 1
        Mid(dstAscii, endPos) = "0"                 'すべて処理済みでも変換済みの数字があれば10倍する
    End If
End Sub

大きく異なる点は、モジュール内の定数や定数的に使用されている文字列を、複数の関数やプロシージャで使用することを想定してモジュールレベル定数にしたことや、カンマや読点で区切られている漢数字(たまにある)を一連の数値とみなす処理を挟んだこと。

ただし後者は、カンマや読点で区切られた複数の数値との見分けが困難な(例えば『一二三、四五六』が123と456なのか12万3,456なのか)シチュエーションが考えられるので、基本的には関数に漢数字を渡す前にふるい分けすることを期待している。

中身はかなり弄ったが、大きくはRegExpオブジェクトの使用をやめたり、京・兆・億・万で分かれていた処理をまとめたり。一番悩んだのが「なるべくコストのかからない処理方法」の模索。

元のconv2num関数による数字変換のプロセスは、万・億・兆・京で文字列を分割し、それぞれにsubconv2関数で英数字に変換。それらを結合して、引数numform・setcomにより変換後の文字列を整形、となっている(引数に万・億・兆・京が含まれている場合)。

KanjiToNum関数も、基本的なコンセプトはconv2num・subconv2numのそれをそのまま引き継いだ。ただ違うのは、conv2num関数では万・億・兆・京それぞれで変数を持っていたが、KanjiToNum関数ではすべて一つの変数に連結することにした。

つまり、例えば「三千五百億」は一度「350000000000」に直してから「350,000,000,000」なり「3500億」なり「3,500億」なりに整形する。この辺あまり効率が良くないとは思ったが、最大公約数的に考えて確実さを優先した。

で、その分、文字列操作処理をなるべく軽くすることにチャレンジした。それがMidステートメントを利用する方法。Mid関数ではない。Midステートメントはステートメントなので、基本的には行頭に書かれていなければならないし、Mid関数は関数なので基本的には式の右辺にあるべきもの。

可能な限り文字列型変数への代入を減らすことでパフォーマンスを改善できないかという試み。

もっと極端なことをやれば、関数内でいちいち結合している定数的な文字列('"*[" & KAN_MYR & "]*"'とか)を全部モジュールレベルで変数なり定数化してしまえばパフォーマンス向上は見込めるが、モジュールの宣言部があまりにもゴチャゴチャしすぎるのでやってない。あとクラス化やプロシージャ化も考えたが、コストが高くなったりメリットを潰してしまったりしたのでそれもやってない。

あと一応、垓より上の数にも対応できるようにはしている。が、一文字の数に限る。恒河沙とか阿僧祇とか不可思議とか無量大数とかには対応できない。それからVBEの仕様上、垓の上の'ジョ'をそのまま使えない(Shift_JISにない)のでひと工夫必要だと思う。

2019-09-19 一部修正

古いコードを貼り付けてしまっていたので新しいコードに差し替えた(一部ちょっと変わった)。あと、'ジョ'の漢字がバグったのでカタカナ表記に修正。

2019-09-22 一部修正

最終バージョンに更新・・・(たぶん)これが一番新しかったと思います。

2019-10-08 一部修正

色々と修正。後日記事を書くかも。

2019-10-11

Midステートメントについての記事を作成。

漢数字を半角英数字に変換 への Writeback

名前:

URLまたはE-Mail:(※リンク表示注意)

コメント:

情報をクッキーに保存する

trackback URI:

http://iso.tank.jp/puroguramu/vba_kanjitonum.tarako