Office TANAKA - Excel VBA Tips[文字列内の数値に書式設定]

たまたま見かけた質問掲示板で、おもしろそうな質問がありました。

　セルに「この商品は1000円です」のような文字列が入力されています。
　こうした文字列内の数値にカンマを付けて「この商品は1,000円です」
　のように変換するにはどうしたらいいでしょう？(岐阜県42才自営業)

その掲示板では力技のマクロによる回答がありましたが、数値の桁数に制限があるなどスマートではありませんでした。
ちなみに「この商品は」や「円です」などの文字列は不定です。
さあ、どうしましょう？一緒に考えてみませんか？
ネタバレを防止するために、当ページの下の方に私が考えた方法を書いておきます。

(1)文字列内に数値が1回しか登場しない場合のやり方→犬の後ろ
(2)文字列内に数値が2回以上登場する場合のやり方→猫の後ろ

文字列内に数値が1回しか登場しない場合

文字列内に数値が1回しか登場しない場合は、けっこう簡単です。ここでのポイントは、Val関数の特性と、Like演算子です。
なお、Like演算子についての詳細な解説は「正規表現のようなマッチング」をご覧ください。

Val関数は、引数に指定した文字列を数値に変換する関数です。ただし、VBAでは自動的に型キャストが行われるため、一般的には意識する必要がありません。Val関数を使う機会はそう多くないのですが、実はVal関数には非常に便利な特性があるんです。それは「文字列の先頭から数字と認識される部分までを変換してくれる」という特性です。

つまり、こういうことです。
　Val("1000")　では、もちろん　1000　が返ります。さらに、
　Val("1000円だぴょ～ん")　のように、数値＋文字列を引数に渡すと、数値部分だけを数値に変換して　1000　を返します。
これを知ってると意外なときに役立ちます。たとえば「123」や「123円」「123ドル」などが混在するデータを純粋な数値に変換する場合、If Right(buf,1) = "円" なんてやらなくていいんです。Val(buf)とすれば、数値の後ろにある文字列を除去できちゃうんです。便利ですね～(^_^)

話を元に戻します。
「この商品は1000円です」を「この商品は1,000円です」に変換するには、次のように考えました。

1000を1,000に変換するのはFormat関数でOKだ
　　　　↓
Val関数を使えば「数値＋文字列」を数値に変換できる
　　　　↓
てことは、元の文字列を「この商品は」と「1000円です」に分解できれば
Val("1000円です")で1000を取得できる
　　　　↓
文字列を先頭から1文字ずつ見てって、数値が出現するとこで分解すればいいや
　　　　↓
ある1文字が、任意の数値かどうかを調べるには、うん！Like演算子だ

ということです。
とりあえずロジックをコード化してみましょう。ここでは、文字列がセルA1に入力されているとします。

Sub Sample1()
    Dim buf As String, RightStr As String, i As Long
    buf = Range("A1")
    ''変数bufを先頭から1文字ずつチェックする
    ''もし任意の数値だったら、そこから後ろを変数RightStrに格納する
    ''Val(RightStr)で数値部分を抜き出す
    ''Val(RightStr)を、Format関数で整形した書式に置き換える
End Sub

変数bufを(文字数分だけ)先頭から1文字ずつチェックするのだから・・・

Sub Sample1()
    Dim buf As String, RightStr As String, i As Long
    buf = Range("A1")
    For i = 1 To Len(buf)
        If Mid(buf, i, 1) が 任意の数値
        ''もし任意の数値だったら、そこから後ろを変数RightStrに格納する
        End If
    Next i
    ''Val(RightStr)で数値部分を抜き出す
    ''Val(RightStr)を、Format関数で整形した書式に置き換える
End Sub

任意の数値かどうかはLike演算子を使って・・・

Sub Sample1()
    Dim buf As String, RightStr As String, i As Long
    buf = Range("A1")
    For i = 1 To Len(buf)
        If Mid(buf, i, 1) Like "#" Then
            RightStr = Mid(buf, i)
            Exit For
        End If
    Next i
    ''Val(RightStr)で数値部分を抜き出す
    ''Val(RightStr)を、Format関数で整形した書式に置き換える
End Sub

数値の抜き出しと、整形と、置換は一気にできそうだな・・・

Sub Sample1()
    Dim buf As String, RightStr As String, i As Long
    buf = Range("A1")
    For i = 1 To Len(buf)
        If Mid(buf, i, 1) Like "#" Then
            RightStr = Mid(buf, i)
            Exit For
        End If
    Next i
    Range("B1") = Replace(buf, Val(RightStr), Format(Val(RightStr), "#,###"))
End Sub

変換した結果は、隣のセルB1に出力しました。これで完成です。

さてさて・・・では、文字列内に数値が2回以上登場する場合はどうでしょう。
その場合は→猫の後ろ
ページの先頭に戻るときは、Homeキーを押してください。

文字列内に数値が2回以上登場する場合

「この商品は1000円(税込み1050円)です」のようなケースです。この「1000」と「1050」をどちらも「1,000」「1,050」に変換したいんです。上述の方法でやろうとすると混乱してきます。数値がいくつ登場するかわからないからです。こんなときは、正規表現の出番でしょう。正規表現についての詳細な解説「正規表現によるマッチング」をご覧ください。

正規表現を使って、文字列内に存在する、数値が連続する部分を、すべて取り出せれば何とかなりそうです。

Sub Sample2()
    Dim buf As String, RE, reMatch, reValue
    Set RE = CreateObject("VBScript.RegExp")
    buf = Range("A2")
    With RE
        .Pattern = 数値が1回以上連続するブロック
        .Global = True    ''←文字列内をすべて検索するオプション(この場合は必須)
        Set reMatch = .Execute(buf)
        ''もし見つかったら
            ''見つかったすべての数値を取り出して
                ''Format関数で整形して
                    ''Replace関数で置換する
    End With
    Set RE = Nothing
    Range("B2") = buf
End Sub

RegExpオブジェクトでは「\d」が任意の数値を表します。また「+」は直前パターンの1回以上の繰り返しですから、「\d+」とすることで「1」や「1234」や「123456789012…」を検索することができます。

Executeメソッドで検索が成功すると、1個以上のMatcheオブジェクトを含むMatchesコレクションが返ります。Matches.Countが0より大きかったら、見つかったことになりますね。

Sub Sample2()
    Dim buf As String, RE, reMatch, reValue
    Set RE = CreateObject("VBScript.RegExp")
    buf = Range("A2")
    With RE
        .Pattern = "\d+"
        .Global = True
        Set reMatch = .Execute(buf)
        If reMatch.Count > 0 Then
            ''見つかったすべての数値を取り出して
                ''Format関数で整形して
                    ''Replace関数で置換する
        End If
    End With
    Set RE = Nothing
    Range("B2") = buf
End Sub

Matchesコレクションのメンバを1つずつ処理するにはFor Eachステートメントがいいでしょう。

Sub Sample2()
    Dim buf As String, RE, reMatch, reValue
    Set RE = CreateObject("VBScript.RegExp")
    buf = Range("A2")
    With RE
        .Pattern = "\d+"
        .Global = True
        Set reMatch = .Execute(buf)
        If reMatch.Count > 0 Then
            For Each reValue In reMatch
                ''Format関数で整形して
                    ''Replace関数で置換する
            Next reValue
        End If
    End With
    Set RE = Nothing
    Range("B2") = buf
End Sub

整形と置換部分は、先の「1回しか登場しない場合」と同じですから・・・

Sub Sample2()
    Dim buf As String, RE, reMatch, reValue
    Set RE = CreateObject("VBScript.RegExp")
    buf = Range("A2")
    With RE
        .Pattern = "\d+"
        .Global = True
        Set reMatch = .Execute(buf)
        If reMatch.Count > 0 Then
            For Each reValue In reMatch
                buf = Replace(buf, reValue, Format(reValue, "#,###"))
            Next reValue
        End If
    End With
    Set RE = Nothing
    Range("B2") = buf
End Sub

となります。
どちらも、テストした結果はOKでした(^_^)