【ワード】漢数字から数字への一括変換マクロ

質問

漢数字を普通の数字に変換するワードのマクロで悩んでいます。
例えば「第三百十五条」だと読みにくいので「第315条」のように
漢数字から数字へ一括変換したいのですが、うまいマクロの作り方の手順が思いつきません。
僕が思いついたやり方といいますと、

一→1
二→2
・・・途中省略・・・
九→9

十条→0条
百条→00条
第十→第1
第百→第1
十→消す
百→消す

こういう手順のマクロを作りました。
しかしこれですと
100～119、201～219、301～319、・・・901～919の部分がうまく変換できません。
何かいい方法は無いものでしょうか？
999条までで結構です。
下は民法のＨＰです。よろしくお願いします。
http://law.e-gov.go.jp/cgi-bin/idxselect.cgi?IDX_OPT=1&H_NAME=%96%af%96%40&H_NAME_YOMI=%82%a0&H_NO_GENGO=H&H_NO_YEAR=&H_NO_TYPE=2&H_NO_NO=&H_FILE_NAME=M29HO089&H_RYAKU=1&H_CTG=1&H_YOMI_GUN=1&H_CTG_GUN=1

回答No.3

misatoanna · ベストアンサー

＃１です。
すばらしいお答えがでてきていますね。
私にはとても考え付きません。

とりあえず、前回の修正版を再度同じＵＲＬに上げておきました。

> 第百三十八条
1038　になる場合も　138　になる場合も、上のように書かれていましたが、うまく
いかない場合の例は　第百三八条　ですね？

> 一回のマクロの実行で１０条づつしか変換されないのですが
足りない記述がありました。ごめんなさい。

お礼

138条についてですけど今度は大丈夫になっていました。

それにしても、一気に変換されていく様子には
おどろかされました。
この先ＶＢをマスターしていかなければいけないなと思うようになりました。
本当にどうもありがとうございましたｍ（＿＿）ｍ

回答No.6

noname#79209

四桁まで条文があるのでしたら、
変数宣言部を
Dim num1 As Long, num2 As Long, num3 As Long, num4 As Long
に変更。

更に
If bregMatch("/第[一壱二弐三参四五六七八九十拾百]+条/k", strNum) = "0" Then
を
If bregMatch("/第[一壱二弐三参四五六七八九十拾百千]+条/k", strNum) = "0" Then
に変更、更に
strWork = bregMatch("/([２-９]?千)/k", strNum)
num4 = Val(Left(StrConv(strWork, vbNarrow), 1))
num4 = num4 - (strWork = "千")
を追加し、
strWork = num3 & num2 & num1
を
strWork = num4 & num3 & num2 & num1
に変更して下さい。

ただ、"第百一八条"のような表記には対応していません。
必ず"第百十八条"のように表記してください。

回答No.5

noname#79209

ゴメンナサイ。
「てにおは」がおかしかったですね。

また、
strWork = bregMatch("/([２-９]?百)/k", strNum)
は
strNumの中の「百」を取り出します。その際、「百」の前に２から９までの数字が入っていたらそれも一緒に取り出します。
もし「台３百十８条（ココを変更しました）」なら「３百」が取り出されます。
num3 = Val(Left(StrConv(strWork, vbNarrow), 1))
で、百の桁の数値がnum3に入ります。但し"百"だけだった場合は（ココの「も」を「は」に変更しました）ゼロになってしまいますから、
num3 = num3 - (strWork = "百")
で、百だけのときには"-1を引いて（結果的には1を足す）"ようにしています。

と読み替えてください。

回答No.4

noname#79209

> brege.dllをダウンロードしてみたものの、その先、何をしていいのかわかりませんでした＾＾；
> これはどう使うものなのでしょうか？

WindowsXPなら、まず、bregexp.dllをWindows\system32フォルダにコピーします。
次にExcel上でVBA編集画面を表示し「標準モジュール」を作成します。
モジュール名は何でもかまいませんがわかりやすい名前にいておく方が良いでしょう。
そのモジュールに、

Public Declare Function bregMatch Lib "C:\Windows\system32\bregexp.dll" Alias "Match" (szRegstr As String, szTarget As String) As String

Public Declare Function bregMatchEx Lib "C:\Windows\system32\bregexp.dll" Alias "MatchEx" (szRegstr As String, szTarget As String, mode As Long) As Variant

Public Declare Function bregReplace Lib "C:\Windows\system32\bregexp.dll" Alias "Replace" (szRegstr As String, szTarget As String) As String

Public Declare Function bregTranslate Lib "C:\Windows\system32\bregexp.dll" Alias "Translate" (szRegstr As String, szTarget As String, ret As String) As Long

Public Declare Function bregSplit Lib "C:\Windows\system32\bregexp.dll" Alias "Split" (szRegstr As String, szTarget As String, limit As Long) As Variant

を挿入します。
その下に、No.3に挙げたファンクション・プロシージャを貼り付けます。

その後、ExcelのA1セルに"第百三十八条"と入力し、
B1セルに"=convNum(A1)"と入力すれば、"第１３８条"と表示されます。

もしbregexp.dllをsystem32へ置きたくなければ、適当なところ（Excelのファイルがあるフォルダ）におき、
上記の"C:\Windows\system32\"の部分をそのファルダ名に変更（5カ所）して下さい。

因みに、
ret = bregTranslate("tr/一壱二弐三参四五六七八九拾/１１２２３３４５６７８９十/gk", strNum, strNum)
は、
漢数字の一から九までをアラビア数字にと、また拾を十に変換します。例えば一と壱は１に変換されます。
"第三百十八条"なら"第３百十８条"と変換されます。
num1 = Val(StrConv(bregMatch("/([１-９])条/k", strNum), vbNarrow))
は、もし"条"の直前の文字が１～９なら、num1にはその数字が入り、それ以外ならnum1はゼロになります。

また、
strWork = bregMatch("/([２-９]?百)/k", strNum)
は
strNumの中の「百」を取り出します。その際、「百」の前に２から９までの数字が入っていたらそれも一緒に取り出します。
もし「３百十八」なら「３百」が取り出されます。
num3 = Val(Left(StrConv(strWork, vbNarrow), 1))
で、百の桁の数値がnum3に入ります。但し"百"だけだった場合もゼロになってしまいますから、
num3 = num3 - (strWork = "百")
で、百だけのときには"-1を引いて（結果的には1を足す）"ようにしています。

正規表現は多彩な検索、置き換えが可能なので非常に便利です。
ぜひ、習得して活用されることをお勧めします。

お礼

くわしい説明ありがとうございます。
出来ました！
それにしても、いろいろやり方があるものなんですね。
こういうのを自分で作れるよう勉強しなければなぁと思うようになりました。
本当にありがとうございました。

回答No.2

noname#79209

bregexp.dll 等を使用して正規表現を使えるようにすると、

Public Function convNum(paraNum)
Dim strNum As String
Dim num1 As Long, num2 As Long, num3 As Long
Dim ret
Dim strWork As String

If IsNull(paraNum) Then
strNum = ""
Else
strNum = paraNum
End If

If bregMatch("/第[一壱二弐三参四五六七八九十拾百]+条/k", strNum) = "0" Then
convNum = ""
Exit Function
End If

ret = bregTranslate("tr/一壱二弐三参四五六七八九拾/１１２２３３４５６７８９十/gk", strNum, strNum)
num1 = Val(StrConv(bregMatch("/([１-９])条/k", strNum), vbNarrow))
strWork = bregMatch("/([２-９]?百)/k", strNum)
num3 = Val(Left(StrConv(strWork, vbNarrow), 1))
num3 = num3 - (strWork = "百")
strWork = bregMatch("/([２-９]?十)/k", strNum)
num2 = Val(Left(StrConv(strWork, vbNarrow), 1))
num2 = num2 - (strWork = "十")

strWork = num3 & num2 & num1
convNum = "第" & StrConv(bregReplace("s/^0+//", strWork), vbWide) & "条"

End Function

で可能かと．．．

参考URL：

http://www.hi-ho.ne.jp/babaq/bregexp.html

お礼

brege.dllをダウンロードしてみたものの、
その先、何をしていいのかわかりませんでした＾＾；
これはどう使うものなのでしょうか？
でもありがとうございました。

回答No.1

imogasi

（１）ワード文章で、第何条（第何章など）を探す
第*条（＊はワイルドカードのつもり）を切り出すルーチンの作成。
（ワードVBA）
ワードで編集ー検索ーオプションーワイルドカードを利用するにチェックー「第*条」で第二十条や第三百十条を拾うことは確認しました。マクロの記録を修正して使える可能性があります。
（２）見つかったときに、その部分を対象に漢数字をアラビヤ数字化
のルーチン
ーー
があると思いますが、ワードVBAは疎遠なので、（２）の部分だけエクセルVBAでやってみました。ワードVBAでも動くことは間違いないでしょう。
質問者は、エクセルVBAを、質問者向けに、少修正はできる方だと信じてます。
ーーー
VBのSPLIT関数に注目して、やってみましたが、大変時間がかかりました（私のせいですが）。こういう文字をいじくるプログラムは
いつも苦労します。
SPLIT関数は a=split(s,X) ですか、少し癖があって
(A)XがSにない場合
　　a(0)=sそのまま,a(1)は存在しない（ここに注意）
（B)XがSにある場合
　　（aa)a(0)="",a(1)="" sがXと同じ場合です。
　　(bb)a(0)=文字、a(1)=""　前に文字有り、後になし
　　(cc)a(0)=""、a(1)=文字　後に文字有り、前になし
(dd)a(0)=文字、a(1)=文字　前後に文字有り
の場合がありえます。
ーー
１０００条を超える条文が合ったような記憶がチラッとあったもので、９９９９条までの仕様にしてます。
例データエクセルシート　A1:A１５
二千三百五十三 ２３５３
千三百二十三 １３２３
三百五 ３０５
千五 １００５
千二十七 １０２７
二十二 ２２
五 ５
二十八 ２８
百 １００
三百 ３００
千 １０００
四百十 ４１０
千六 １００６
五十 ５０
三百二十 ３２０
B列の書式は文字列にします。そうしないと大文字にならない。
コード
Sub test01()
k = Array("", "一", "二", "三", "四", "五", "六", "七", "八", "九")
t1 = Array("千", "百", "十")
t2 = Array(1000, 100, 10)
For r = 1 To 15
s = Cells(r, 1)
n = 0
'------
' MsgBox UBound(t1)
For i = 0 To UBound(t1) 'i=0,1,2 単位の文字
a = Split(s, t1(i))
'--単位文字なし
If InStr(s, t1(i)) = 0 Then GoTo p03 '単位文字なし、次の単位検索　次のiへ
' sは変えなくて良い。そのまま
'--単位文字あり
'--a(0)単位の左に数字なし、単位文字だけ
If a(0) = "" Then '単位文字だけ.1＊単位数を加算
x = 1
n = n + x * t2(i) '単位＊数字を加える
s = a(1) '単位文字の後に文字あり
GoTo p03 '次の単位検索　次のiへ
End If
'--a(0)単位の左に数字有り
'---a(0)単位の前の数字を数字化
p01:
For j = 1 To UBound(k)
If a(0) = k(j) Then
x = j
GoTo p02
End If
Next j
x = 0
'-----
p02:
n = n + x * t2(i) 'nに、単位数＊数字を加える
'----a(1)単位のあとの数字について
If a(1) = "" Then GoTo p06 '単位の後は無し。終了　次の行データへ
'---単位の後を対象として、次の単位へ
s = a(1)
If i = 2 Then GoTo p04 '単位文字が十まできたときは繰り返さない
'---
p03:
Next i
'----十単位以下の漢字数字を数字化
p04:
If s = "" Then GoTo p06
For j = 1 To UBound(k)
If s = k(j) Then
x = j
GoTo p05
End If
Next j
x = 0
p05:
n = n + x
p06:
Cells(r, "B") = StrConv(n, vbWide)
Next r
End Sub
ーーー
余程のこういう課題向けの仕掛け（アルゴリズム）を工夫しないとこれ以上すっきりしないのではないかと、思います。
これ以上すっきりした回答が出なかったら、検討してみてください。
またおかしい結果になる特殊例でもあれば、ご指摘ください。

お礼

お忙しい中、ありがとうございます。
しかし僕の場合、ＶＢの入門書を一冊読み終えた
ばかりという程度ですので、（１）もよくわかりません。
せっかく時間をかけて考えていただいたのに、
活用できなくてすみません＾＾；