洋々亭　文書処理・お仕事Tips

お仕事Tipsトップ >> Word：漢数字⇒算用数字変換マクロ

■Word：漢数字⇒算用数字変換マクロ

　国がネット公開している法律案や法律法令データ提供システムでは、漢数字が使われています。これをコピーして横書きで印刷すると、極めて読みにくくなります。しかし、いちいち入力し直すのは面倒です。

　そこで、Microsoft Wordのマクロで、漢数字から算用数字（アラビア数字）に一括変換する「漢数字⇒算用数字変換マクロ」を作りました。単純機能ですが、結構使えます。

　New! バージョンアップ Ver0.6（バグ修正：2012/02/26)

　　・接頭単位によって無限ループになるバグを暫定修正。

一発で
変換！
→→→→

▲条項のほか、「○分の○」や
　「○年」も変換する。

■マクロコードの登録について

下記のマクロコードをコピーします。
（コードの下の [ コードを全選択 ] をクリックすると選択状態になるので、コードを右クリックして、ポップアップメニューの[コピー]を選びます。）
Wordで新規文書を起動し、ショートカットキー　 Alt ＋　F11 　でマクロ編集画面（VBA ：右図）を開きます。
VBAの左側のペインで、Normalの標準モジュールの中のModule1を選択します。
　※　もし、Normalの中に標準モジュールがない場合は、Normalを右クリックし表示されるメニューから[挿入]⇒[標準モジュール]をクリックして追加します。
コード欄にコピーしたコードを貼り付けます。
　　（詳細：Wordマクロコードの登録方法）
そのマクロに不安があったら：
ネットからコピーしたコードには、ウイルスが潜んでいる可能性があります。不安があったら、空白文書にいったん保存し、そのファイルを「Wordで開く前に」ワクチンソフトでチェックしてから利用しましょう。（個別文書に登録し、ウイルスと作動チェックを行う方法）

Option Explicit

Sub 漢数字to算用数字変換()
'----------------------------------------
'MS-Word用マクロ：漢数字を英数字に変換
'作成者　洋々亭 2006-2012
'2012/02/26:  Ver0.6 ' 暫定修正
'2011/01/10:  Ver0.5
'【改変履歴】
'2010/10/04:  Ver0.4
'○使うサブルーチン：
'    function conv2num(skan,[numform],[setcom])
'    function subconv2num(skan)  ' conv2num()のサブルーチン
'----------------------------------------
  Const NOCOM = 0   'コンマ不使用(規定値)
  Const COMMA = 1   'コンマ使用
  Const MIXNUM = 0  '万億兆を混在（3万6000）
  Const PURENUM = 1 '万億兆は不使用。（36,000)

  Dim flgMans As Long ' 0…4桁区切りを入れる(32万6,500円)／1…入れない(326,500円)
  Dim flgCom As Long  ' 0…カンマを使わない(2700万円)／1…使うわない(2,700万円)
  Dim str As String, kcketa As String, buf As String
  Dim ileng As Long
  Dim unit As String, headunit As String, piriunit As String, mansunit As String
  Dim sKancom As String ' 「、」をカンマとみなすかどうか設定
  Dim myRange As Range, para As Paragraph
  Dim RE As Object, RE2 As Object, Matches As Object, Match As Object
  Set RE = CreateObject("VBScript.RegExp")
  Set RE2 = CreateObject("VBScript.RegExp")
  RE.Global = False   'True:全ての検索結果を処理、False:初出の結果のみ処理
  RE2.Global = False
  
' -----------------  変換設定フラグ（不要な方をコメントアウト）----------
   'flgMansの設定：(漢数くん使用時は引数使用)
  flgMans = MIXNUM    '0(MIXNUM)…万億兆を混在（3万6000）
'  flgMans = PURENUM  ' 1(PURENUM)…万億兆は不使用(36,000)
   
   'flgComの設定：(漢数くん使用時は引数使用)
  flgCom = NOCOM  '0(NOCOM)…カンマを使わない(2700万円)
'  flgCom = COMMA   '1(COMMA)…使う(2,700万円)
  
   'sKancom設定：
  sKancom = ""  '[ = "" ]で、句読点をカンマとみなさない。
'  sKancom = "、"  '[ ="、" ]で、句読点をカンマとみなす。
     
' ------------------------------------------------------------------------

   ' 変換単位（複数文字可）
  unit = "(・|\.|人|名|円|年|月|日|時|分|秒|世紀|章|節|条|項|号|目|款|歳|番|番地" & _
    "|点|匹|頭|羽|冊|本|枚|台|機|回|軒|件|県|審|間|世帯|米|平方|立方" & _
    "|以上|以下|未満|を超え" & _
    "|キロ|メガ|トン|メートル|センチ|ミリ|マイクロ|ミクロン|ヤード|ポンド|インチ|エーカー" & _
    "|リットル|ガロン|ヘクト|パーセント|ベクレル|シーベルト|グレイ|ドル|ユーロ|元|ウォン" & _
    "|\%|％|cm|ｃｍ|Cm|Ｃｍ|℃|μ|m|ｍ|M|Ｍ|k|ｋ|K|Ｋ|Sv|Ｓｖ|Bq|Ｂｑ|Gy|Ｇｙ" & _
    "|光年|パーセク|ー)"
   ' 頭部変換単位（複数文字可）
  headunit = "(問|問題|人口|第|マッハ|ワープ|セシウム|カリウム|ヨウ素|炭素|ウラン|ストロンチウム)"
  mansunit = "(京|兆|億|万)"
   ' ピリオド単位
  piriunit = "(・|\.)"
  
   ' 変換範囲（段落=paragraph単位で変換）
  If Selection.Start = Selection.End Then
    Set myRange = ActiveDocument.Range   '範囲選択しなければ文書全体
  Else
    Set myRange = Selection.Range    '選択された範囲内の段落のみ
  End If
  
  For Each para In myRange.Paragraphs
      ' 文書を一気に変換すると表が解除されるのでパラグラフごとに変換
      ' 途中でパラグラフを移動させないため、文字列bufにコピーして作業
    buf = para.Range.Text
    
      '「**条『の**』」、「百分『の五十』」の部変換
    RE.Pattern = "([〇○一二三四五六七八九十百千]+)" & _
       "([章|節|条|項|分]の)([〇○一二三四五六七八九十百千]+)"
    Do
      Set Matches = RE.Execute(buf)
      If Matches.Count > 0 Then
        str = conv2num(Matches(0).SubMatches(0), flgMans, flgCom)
        str = str & Matches(0).SubMatches(1)
        str = str & conv2num(Matches(0).SubMatches(2), flgMans, flgCom)
        RE2.Pattern = Matches(0).Value
        buf = RE2.Replace(buf, str)
      End If
    Loop Until Matches.Count = 0
      '条・項・号変換
    RE.Pattern = "第([一二三四五六七八九十百千]+)(章|節|条|項|号)"
    Do
      Set Matches = RE.Execute(buf)
      If Matches.Count > 0 Then
        str = conv2num(Matches(0).SubMatches(0), flgMans, flgCom)
        str = "第" & str & Matches(0).SubMatches(1)
        RE2.Pattern = Matches(0).Value
        buf = RE2.Replace(buf, str)
      End If
    Loop Until Matches.Count = 0
          '小数点「・」以下変換　(十百千の桁文字持たないことが前提)
    RE.Pattern = piriunit & "([〇○一二三四五六七八九]+)"
    Do
      Set Matches = RE.Execute(buf)
      If Matches.Count > 0 Then
        str = conv2num(Matches(0).SubMatches(1), flgMans, NOCOM)
        str = "." & str
        RE2.Pattern = Matches(0).Value
        buf = RE2.Replace(buf, str)
      End If
    Loop Until Matches.Count = 0
      '「**人、**円、**年**月**日」部変換
      '2011/01/10：「二十万円」等で無限ループになるバグ修正
      '           （RE.Pattern、SubMatches(N)を変更）
    RE.Pattern = "(([〇○一二三四五六七八九十百千" & sKancom & "]+[万億兆京]*)+)" & unit
    Do
      Set Matches = RE.Execute(buf)
      If Matches.Count > 0 Then
            str = conv2num(Matches(0).SubMatches(0), flgMans, flgCom)
            str = str & Matches(0).SubMatches(2)  '単位結合
            RE2.Pattern = Matches(0).Value
            buf = RE2.Replace(buf, str)
      End If
    Loop Until Matches.Count = 0
      '「問**、マッハ**、ワープ**」など、頭部単位変換
    RE.Pattern = headunit & "([〇○一二三四五六七八九十百千]+)"
    Do
      Set Matches = RE.Execute(buf)
      If Matches.Count > 0 Then
        str = conv2num(Matches(0).SubMatches(1), flgMans, flgCom)
        str = Matches(0).SubMatches(0) & str  '単位結合
        RE2.Pattern = Matches(0).Value
        buf = RE2.Replace(buf, str)
      End If
    Loop Until Matches.Count = 0
    
' 行頭の「○３」を「③」に変換。この機能を使いたい場合は、
' 次の行から、End Ifまでのコメント「'」を外してください。

'    RE.Pattern = "^○[０１２３４５６７８９]+"
'    Do
'      Set Matches = RE.Execute(buf)
'      If Matches.Count > 0 Then
'        ileng = Matches(0).Length
'        str = marumoji(Matches(0).Value, ileng)
'        RE2.Pattern = Matches(0).Value
'        buf = RE2.Replace(buf, str)
'      End If
'    Loop Until Matches.Count = 0

      ' 作業bufが変更されていたら、paragraph置き換え
    If buf <> para.Range.Text Then
      para.Range.Text = buf
    End If
  Next
  Set RE = Nothing
  Set Matches = Nothing
  Set Match = Nothing
  Set myRange = Nothing
End Sub
  
Function conv2num(skan As String, _
    Optional numform As Long, _
    Optional setcom As Long) As String
'------------------------------------------------------------------
' ○conv2num関数 ：漢数字の文字列を英数字の文字列に変換する。
'作成者　洋々亭 2010
' 2010/9/20  Ver0.1  全面書換え。万億兆京含む変換。千位はsubconv2num()呼び出し変換
' 2010/10/4  ver0.12 ロジック整理
' ○引数
'   skan  ：処理する漢数字（「五十万千七百五」,「五○一七〇五」どちらも可）
'   numform ：0(MIXNUM)…(規定値)万億兆京の表示／1(PURENUM)…算用数字のみ
'   setcom  ：0(NOCOM)…(規定値)カンマ不使用／1(COMMA)…3桁ごとにカンマ入れる
' ○戻り値
'   変換結果の文字列
' ○使うサブルーチン
'    function subconv2num(skan)
'------------------------------------------------------------------
  Const NOCOM = 0   'コンマ不使用(規定値)
  Const COMMA = 1   'コンマ使用
  Const MIXNUM = 0  '万億兆を混在（3万6000）
  Const PURENUM = 1 '万億兆は不使用。（36,000)
  Dim i As Long, ileng As Long, ipos As Long
  Dim swork As String, sbuf As String, buf As String, sdot As String
  Dim skei As String, styo As String, soku As String, sman As String, ssen As String
  Dim kkei As String, ktyo As String, koku As String, kman As String
  Dim RE As Object, Matches As Object
  Set RE = CreateObject("VBScript.RegExp")
  RE.Global = True   'True:全ての検索結果を処理、False:初出の結果のみ処理

  swork = skan
  ' 万億兆京が無い漢数字の場合（万未満、または「三○五八七」など）
  RE.Pattern = "[万億兆京]"
  Set Matches = RE.Execute(swork)
  If Matches.Count = 0 Then
    sbuf = subconv2num(swork)
    If setcom = COMMA Then
      sbuf = Format(sbuf, "#,###")
    End If
    conv2num = sbuf
    Exit Function
  End If
  
  ' 万以上の漢数字が存在する場合
  ipos = InStr(swork, "京")    '京の有無(無いとき0)
  If ipos > 0 Then
    buf = Left(swork, ipos - 1)   '京の数字
    skei = subconv2num(buf)
    swork = Right(swork, Len(swork) - ipos)   '京未満部分
    kkei = "京"
  Else
    skei = "": kkei = ""  'この桁が存在しないときは空白を接続
  End If
  ipos = InStr(swork, "兆")    '兆の有無(無いとき0)
  If ipos > 0 Then
    buf = Left(swork, ipos - 1)   '兆の数字
    styo = subconv2num(buf)
    styo = Format(styo, "0000")
    swork = Right(swork, Len(swork) - ipos)  '兆未満部分
    ktyo = "兆"
  Else
    styo = "0000": ktyo = ""
  End If
  ipos = InStr(swork, "億")    '億の有無(無いとき0)
  If ipos > 0 Then
    buf = Left(swork, ipos - 1)   '億の数字
    soku = subconv2num(buf)
    soku = Format(soku, "0000")
    swork = Right(swork, Len(swork) - ipos)   '億未満部分
    koku = "億"
  Else
    soku = "0000": koku = ""
  End If
  ipos = InStr(swork, "万")    '万の有無(無いとき0)
  If ipos > 0 Then
    buf = Left(swork, ipos - 1)   '万の数字
    sman = subconv2num(buf)
    sman = Format(sman, "0000")
    swork = Right(swork, Len(swork) - ipos)   '万未満部分
    kman = "万"
  Else
    sman = "0000": kman = ""
  End If
  If swork = "" Then
    ssen = "0000"    '万以下の部分がないとき0で埋め
  Else
    ssen = subconv2num(swork)   '万未満の数字
    ssen = Format(ssen, "0000")
  End If
  
        ' ※　関数Format( x , "#,###" )は、x = 0 のとき、空白を返す。
  If numform = PURENUM Then   ' 万億兆使わない指定のとき(例：6,543,210)
    sbuf = skei & styo & soku & sman & ssen
    sbuf = Format(sbuf, "#,###")
  Else
    If setcom = COMMA Then
      sbuf = Format(skei, "#,###") & kkei & Format(styo, "#,###") & ktyo & _
      Format(soku, "#,###") & koku & Format(sman, "#,###") & kman & Format(ssen, "#,###")
    Else
      sbuf = Format(skei, "####") & kkei & Format(styo, "####") & ktyo & _
      Format(soku, "####") & koku & Format(sman, "####") & kman & Format(ssen, "####")
    End If
  End If
  conv2num = sbuf
  Exit Function
End Function

Function subconv2num(skan As String) As String
'------------------------------------------------------------------
' ○subconv2num関数 ：漢字4桁（千百十一位）を算用数字に変換して返すサブ関数
'作成者　洋々亭 2010
' 2010/9/20  Ver0.1
' ○引数
'   skan  ：処理する漢数字（「二千七百五」,「二、七〇五」どちらも可）
' ○戻り値
'   変換結果の文字列（ex:二千七百五　→　2705）
'------------------------------------------------------------------
  Const KANopNUM = "〇○一二三四五六七八九、・"  '桁漢字無(ピリオド付）
  Const KANNUM = "一二三四五六七八九"     '桁漢字付き用
  Const KANKETA = "十百千"         '桁漢字（千まで）
  Const ALpNUM = "00123456789,."       '英数字（ピリオド付）
  Dim i As Long, ileng As Long, cnt As Long, iketa As Long, skpflg As Long
  Dim pos As Long, san As Long
  Dim kcsu As String, sbuf As String
  
  iketa = 1     '現在処理中の英数字の桁数
  sbuf = ""
  '桁漢字 [十百千] の有無で処理を分岐
  cnt = 0
  ileng = Len(skan)
  pos = ileng    'pos:漢字文字列中の処理中文字ポインタ
  For i = 1 To ileng
    cnt = cnt + InStr(KANKETA, Mid(skan, i, 1))
  Next
  If cnt = 0 Then
    '桁漢字を使わない表記の場合（例：二、七〇五）
    For i = 1 To ileng
      kcsu = Mid(skan, i, 1)
      sbuf = sbuf & Mid(ALpNUM, InStr(KANopNUM, kcsu), 1)
    Next
    sbuf = Replace(sbuf, ",", "") 'カンマ削除
  Else
    '桁漢字を使う表記の場合（例：二千七百五）
    Do
      skpflg = 0
      kcsu = Mid(skan, pos, 1)
      san = InStr(KANNUM, kcsu)
      If iketa > 1 Then
        If kcsu = Mid(KANKETA, iketa - 1, 1) Then
          pos = pos - 1
          If pos < 1 Then
            sbuf = "1" & sbuf
            Exit Do
          End If
          kcsu = Mid(skan, pos, 1)
          san = InStr(KANNUM, kcsu)
        Else
          sbuf = "0" & sbuf
          iketa = iketa + 1
          skpflg = 1
        End If
      End If
      If skpflg = 0 Then
        If san = 0 Then
          If iketa = 1 Then
            sbuf = "0"
          Else
            sbuf = "1" & sbuf
          End If
          iketa = iketa + 1
        Else
          sbuf = san & sbuf
          iketa = iketa + 1
          pos = pos - 1
        End If
      End If
    Loop While iketa <= 4 And pos > 0
  End If
  subconv2num = sbuf
  Exit Function
End Function

Function marumoji(skan As String, ileng) As String
'---------------------------------------------------------------------
' 作成者　洋々亭 2006
' ○marumoji関数 ：「○３」形式の標記を「③」に変換する。
' ○引数
'     skan  ：処理する漢数字（例：「○３」,「○１２」）
'     ileng ：処理する文字列の長さ（「○１２」なら3)
' ○戻り値
'     変換結果の文字列（○２０以上は[21]のように変換）
'---------------------------------------------------------------------

    Dim skcsan As String, sansu As String, smarusu As String
    Dim kcsu As String, sbuf As String
    Dim i, cnt
    skcsan = "０１２３４５６７８９"         '桁漢字有り用
    sansu = "0123456789"                    '桁漢字無し用置き換え英数字
    smarusu = "①②③④⑤⑥⑦⑧⑨⑩⑪⑫⑬⑭⑮⑯⑰⑱⑲⑳"    '丸付数字
    sbuf = ""
    For i = 2 To ileng
        kcsu = Mid(skan, i, 1)
        sbuf = sbuf & Mid(sansu, InStr(skcsan, kcsu), 1)
    Next
    cnt = Val(sbuf)
    If cnt > 20 Or cnt = 0 Then
        marumoji = "[" & sbuf & "]"
    Else
        marumoji = Mid(smarusu, cnt, 1)
    End If
    Exit Function
End Function

' ===================== End Of Code =======================

■漢数字変換マクロの使い方

　試しに、国の法令情報提供システムの法令を、Wordに取り込んで変換してみましょう。

Wordで、先にマクロを登録した文書を開きます。
法令情報提供システムの法令検索し、法令文を表示し、テキストをコピーします。　（必要な部分をマウスでなぞる⇒右クリック⇒メニューで「コピー」）
Wordのメニューで[編集]-[形式を選んで貼り付け]-[テキスト]で、貼り付けます。
※　そのまま[貼り付け]を選ぶと、HTMLの書式までコピーされるので注意してください。
処理範囲を指定できます。一部のみ変換したいときは、マウスで範囲を指定してから、以下に進んでください。範囲指定しない場合は文書全体が処理範囲となります。
マクロ実行ダイアログから実行：
Wordを起動し、ショートカットキー　 Alt ＋　F８　でマクロ実行ダイアログを開きます。
マクロダイアログから、マクロ名の「漢数字to算用数字変換」を選択し、[実行]を押します。
文書が大きい場合は、変換に若干時間がかかる場合があります。
マクロを強制終了したい場合は、慌てないで[ Ctrl ] + [ Break ] キーを押します。

このマクロはフリーソフトとし、取扱いはGPLに準拠します。
ただし、他のマクロに組み込んだり、その他の方法で、他に配布する場合は原作著作表示を残していただけるとうれしいです。
作者はこのマクロ及び本ドキュメントを使用した結果について何ら責任を負いません。