【Word VBA】桁区切りのコンマを入れる

このテーマは多くの方が挑戦されているような気がします。

大阪のワードマクロ勉強会 の参加者の方からご要望をいただきましたので作ってみました。

ワイルドカードを使ったマクロのいい例だと思いますね。

少し無理をしている感じもありますが、私なりの解決策を紹介します。

参考にした記事

インストラクターのネタ帳  (有名なサイトです。お世話になっています。)

Wordで実践 やさしくて役に立つ「マクロ」事例集 P.137

このマクロでできること

文書中の4桁以上の半角数字を探して、見つけた数字が段落番号ではない場合と、年号ではない場合に、3桁ごとに半角のコンマを挿入します。あと、小数点以下の数字には当然のことながら、コンマは入れません。

[1,234] (段落番号)

2,011年8月6日 (年号)

3.141,592,653 (円周率)

これはNGですよね。こうならないように工夫してあります。

あと、ここでいう段落番号というのは、特許明細書に記載されているものを意味しておりまして、上記のように半角のスクウェア・ブラケット「[」と「]」で囲まれた4桁の半角数字を意味しています。

「段落番号ではない」という条件が、特許翻訳者の私のマクロの特徴です(笑)。

マクロの解説

判定方法をご紹介します。

まず、簡単なほうから。

①年号ではないことを判定するための方法

これは、見つけた数字の後ろに「年」と入っているかどうかを判定しているだけです。

Next プロパティを使っています。

選択範囲の手前や後ろの文字を特定する 」で紹介したとおりです。

こちらの記事でも少しだけ解説していますが、Nextプロパティがどの語を特定するのか癖を理解しないといけませんね。

SelectionオブジェクトやRangeオブジェクトの直後にNextプロパティを設定した場合には、直後の一文字を選択するようです。

②段落番号ではないことを判定するための方法

選択した数字が、半角のスクウェア・ブラケット「[」と「]」で囲まれているかどうかで判定しています。

Next プロパティとPreviousプロパティを利用しました。

特に4桁であるかどうかは見ておりません。そういう意味では要注意です。

③小数点以下の数字ではないことを判定するための方法

ここまでくると想像が付くかもしれませんが、選択した数字の1文字前が半角のピリオドかどうかを確認しています。Previousプロパティを利用しています。

青文字のとおり、コンマを入れるために置換をしていますが、Mid関数 を使っても同じことができると思います。

コンマを入れるべき文字列が見つかりさえすれば、処理方法はいろいろとやり方があると思います。

マクロ


Sub 半角数字にコンマ挿入()
  Dim myRange As Range
  Dim myLen As Integer

  '文書の末尾にRangeオブジェクトを設定
  With ActiveDocument
    Set myRange = .Range(.Range.End - 1, .Range.End - 1)
  End With

  'ワイルドカードで4桁以上の数字を検索
  '文書の末尾から先頭に向けて検索します
  With myRange.Find
    .Text = "([0-9]{1,})([0-9]{3,3})"
    .Replacement.Text = "\1,\2"
    .Forward = False
    .Wrap = wdFindStop
    .MatchWildcards = True
  End With

  '4桁以上の数字が見つかったときの処理
  With myRange
    Do While .Find.Execute = True
      '数字が文頭の場合
      If .Start = 0 Then
        If .Next.Text <> "年" Then
          myLen = Len(myRange)
          .Find.Execute Replace:=wdReplaceOne
          .SetRange .End + myLen, .End + myLen
        End If
      '数字が文頭以外の場合
      Else
        If .Previous.Text <> "." And _
          .Previous.Text <> "[" And _
          .Next.Text <> "年" And _
          .Next.Text <> "]" Then
          myLen = Len(myRange)
          .Find.Execute Replace:=wdReplaceOne
          .SetRange .End + myLen, .End + myLen
        End If
      End If
    Loop
  End With
  'Rangeオブジェクトの解放
  Set myRange = Nothing
End Sub

トップへ戻る