【VBS】1桁の数字を全角に、2桁以上の数字を半角に変換するには

[記事公開]2022.10.07
VBS
VBS

以前書いた記事のさらに続きです。あるお役所や会社のローカルルールで、1桁の数字を全角に、2桁以上の数字を半角に変換するというものがあります。これをいかに労働生産性を下げないよう、効率よくやるか、以前Excel版とWord版を紹介したのですが、今回はVBS(Visual Basic Script)でやるならどうやるか？を紹介します。

ExcelとWordだけあれば十分じゃないかと思ったのですが、こういう↓掲示板を読みまして、

http://fpcu.on.coocan.jp/dosvcmd/bbs/log/wshwindows_scro/4-0049.html

Excel+VBAでやったほうが楽な気がしますけど。
http://fpcu.on.coocan.jp/dosvcmd/bbs/log/wshwindows_scro/4-0049.html

という回答者さんの言葉に、

ツールを使うことはできないんですよ^^;
ファイル作成はCOBOLでやっているのですがそちらのほうに変換機能があったようなのでそちらで処理させることにしました。
http://fpcu.on.coocan.jp/dosvcmd/bbs/log/wshwindows_scro/4-0049.html

と答える質問者様・・・・ああ、そうだった、セキュリティがガチガチな環境だと、Alt＋F11(VBE起動)すら禁止されているのだったと思いだしましたので。

ExcelやWordのマクロが使えないなら、VBSくらいしか使えそうなものがないですよね。VBSなら、Windowsを購入すると否が応でもついてきますし。

余談ですが、COBOLっていうのがいかにもな感じがしました。私も入口はCOBOL85でした(仕事の都合です)。不自由な環境というのは、とことん不自由ですよね！ちなみに、このCOBOLを使っていた職場環境では、インターネットに接続することも禁じられていました。アクセスログもバリバリに採取され、ルールにないことは一切できない、がんじがらめのシビアな環境でした。それだけ個人情報や機密情報がある環境だったということなのでしょう、仕方がないのですが、それと引き換えに労働生産性や能力向上等をあきらめないといけないというのは、すごくストレスフルでした。

1. VBSのコード
2. 使い方
3. コードの解説
4. 免責事項
5. まとめ

VBSのコード

最初に、コードを全部一気に掲示しておきます。

Option Explicit
'
' 1桁の数字を全角に、2桁以上の数字を半角に変換する。
'
Const HAN = " !#$%&?\()[]{}<>=-+*^/,._;:|@`･"      ' ~"'を除く    '……(1)
Const ZEN = "　！＃＄％＆？\（）［］｛｝＜＞＝－＋＊＾／，．＿；：｜＠｀・"
Const wdWidthHalfWidth = 6                                        '……(2)
Const wdWidthFullWidth = 7
'Dim WScript As New WScriptObj   'VBAの場合に使用                 '……(3)
Main                             'VBSの場合に使用
'メインを実行
Public Sub Main()
    Dim txtStrm, stPath, FSO, regEx

    Set FSO = CreateObject("Scripting.FileSystemObject")          '……(4)
    Set regEx = CreateObject("VBScript.RegExp")   
    stPath = WScript.Arguments(0)                                 '……(5)
    txtStrm = txtReadAll(stPath, FSO)                             '……(6)
    Call findReplace(txtStrm, regEx, "[0-9０-９,.,．]", wdWidthFullWidth)       '……(7)'
    Call findReplace(txtStrm, regEx, "[0-9０-９,.,．]{2,}", wdWidthHalfWidth)   '……(8)'
    
    Call txtWriteAll(txtStrm, stPath, FSO)                         '……(9)

    Set regEx = Nothing                                            '……(4)´
    Set FSO = Nothing
    WScript.Quit                                                   '……(10) 

End Sub

Private Sub findReplace( _
         ByRef txtStrm, _
         ByRef regEx, _
         ByRef stText, _
         ByRef wWidth)
                                                                 '……(11)    
    Dim stRet, Matches, vStrm
    
    '正規表現の各種設定
    regEx.Pattern = stText      'パターン
    regEx.IgnoreCase = True     '大文字と小文字を区別しない
    regEx.Global = True         '文字列全体を検索する
    
    vStrm = txtStrm
    
    Set Matches = regEx.Execute(vStrm) 
    Do While Matches.Count > 0                                   '……(12)'
        If Matches(0).FirstIndex > 0 Then
            stRet = stRet & Left(vStrm, Matches(0).FirstIndex)
        End If
        If wWidth = wdWidthHalfWidth Then
            stRet = stRet & StrConvNarrow(Mid(vStrm, Matches(0).FirstIndex + 1, Matches(0).Length))
        Else
            stRet = stRet & StrConvWide(Mid(vStrm, Matches(0).FirstIndex + 1, Matches(0).Length))
        End If
        vStrm = Right(txtStrm, Len(vStrm) - Matches(0).FirstIndex - Matches(0).Length)
        Set Matches = regEx.Execute(vStrm)                       '……(13)'
    Loop
    
    txtStrm = stRet & vStrm

End Sub
'https://qiita.com/takahasinaoki/items/4ff08f0b733ddc6c6927
'*****************************************************************************
'[概要] 半角英数字を全角に変換する
'[引数] 変換対象文字列
'[戻値] 変換後文字列
'*****************************************************************************
Function StrConvWide(ByVal strWord)
    Dim i, j, strChar, lngChar
    For i = 1 To Len(strWord)
        strChar = Mid(strWord, i, 1)
        lngChar = Asc(strChar)
        If Asc("A") <= lngChar And lngChar <= Asc("Z") Then
            strChar = Chr(lngChar + Asc("Ａ") - Asc("A"))
        ElseIf Asc("a") <= lngChar And lngChar <= Asc("z") Then
            strChar = Chr(lngChar + Asc("ａ") - Asc("a"))
        ElseIf Asc("0") <= lngChar And lngChar <= Asc("9") Then
            strChar = Chr(lngChar + Asc("０") - Asc("0"))
        Else
            j = InStr(1, HAN, strChar)
            If j > 0 Then
                strChar = Mid(ZEN, j, 1)
            End If
        End If
        StrConvWide = StrConvWide & strChar
    Next
End Function
'https://qiita.com/takahasinaoki/items/4ff08f0b733ddc6c6927
'*****************************************************************************
'[概要] 全角英数字を半角に変換する
'[引数] 変換対象文字列
'[戻値] 変換後文字列
'*****************************************************************************
Function StrConvNarrow(ByVal strWord)
    Dim i, j, strChar, lngChar
    For i = 1 To Len(strWord)
        strChar = Mid(strWord, i, 1)
        lngChar = Asc(strChar)
        If Asc("Ａ") <= lngChar And lngChar <= Asc("Ｚ") Then
            strChar = Chr(lngChar - Asc("Ａ") + Asc("A"))
        ElseIf Asc("ａ") <= lngChar And lngChar <= Asc("ｚ") Then
            strChar = Chr(lngChar - Asc("ａ") + Asc("a"))
        ElseIf Asc("０") <= lngChar And lngChar <= Asc("９") Then
            strChar = Chr(lngChar - Asc("０") + Asc("0"))
        Else
            j = InStr(1, ZEN, strChar)
            If j > 0 Then
                strChar = Mid(HAN, j, 1)
            End If
        End If
        StrConvNarrow = StrConvNarrow & strChar
    Next
End Function

Private Function txtReadAll(ByRef stPath, ByRef FSO)
    
    
    ' ファイルを読み取り専用で読み込み
    Dim stream
    Set stream = FSO.OpenTextFile(stPath, 1)
    
    ' テキストファイルの一括読み込み
    txtReadAll = stream.ReadAll
    
    ' テキストファイルを閉じる
    stream.Close
    Set stream = Nothing
    

End Function

Private Sub txtWriteAll(ByRef txtStrm, ByRef stPath, ByRef FSO)
    Dim stream
    Set stream = FSO.OpenTextFile(stPath, 2)
    ' 書き込み
    Call stream.Write(txtStrm)

    ' ファイルクローズ
    stream.Close
    
    Set stream = Nothing
End Sub

コピーしてメモ帳に貼りつけ、名前を付けて保存するときに拡張子をvbsにすると、VBScriptになります。

使い方

デスクトップにVBSを置いておき、そこに対象のテキストをドラッグアンドドロップします。

特に何もメッセージも出ず、あっという間にテキストの中身が書き換えられますので、書き換えたいテキストはあらかじめバックアップ用にコピーしておくことをおすすめします。

テキストだけに対応しています。

HTMLやXMLには対応していませんので悪しからず。

コードの解説

Const HAN = " !#$%&?\()[]{}<>=-+*^/,._;:|@`･"      ' ~"'を除く    '……(1)
Const ZEN = "　！＃＄％＆？\（）［］｛｝＜＞＝－＋＊＾／，．＿；：｜＠｀・"

↑このConst定義は、のちに出てくるStrConvWideとStrConvNarrowで使います。

StrConvWideとStrConvNarrowは、この↓サイトにあるものを使わせていただきました。

https://qiita.com/takahasinaoki/items/4ff08f0b733ddc6c6927

VBSにはStrConvによる全角変換、半角変換がありません。自作するしかないようです。

一般的には、BASP21という追加パッケージをインストールして使うらしいですが、今回対象としている読者が、お役所のバリバリにセキュリティ管理され、プレインストールされたもの以外は勝手にインストールできない環境の人という想定なので、こうなりました。

Const wdWStrConvidthHalfWidth = 6                                        '……(2)
Const wdWidthFullWidth = 7

↑ここでは何をやっているかというと、WordのVBAではWdCharacterWidth定数というのが用意されていましたが、VBSではそんなものはない(そもそもEnumが使えない)ので、ここでConst定義しています。

'Dim WScript As New WScriptObj   'VBAの場合に使用                 '……(3)
Main                             'VBSの場合に使用

↑ここでは何をやっているかというと、今回VBSを作るに当たり、ExcelVBAのVBEを使って開発しましたので、そのときの制御のカスがこれです。

VBSを作るとき何が大変って、デバッグが大変なんですが、VBAとVBSはほぼ似たようなものなので、VBEでVBSをデバッグすることも可能です。

そこで今回↓こちらのサイトを参考に、VBEでVBSを開発しました。

VBScriptをお手軽にデバッグして開発する方法

https://qiita.com/saeki4n/items/fc1e19c8b2348230d6b6

    Set FSO = CreateObject("Scripting.FileSystemObject")          '……(4)
    Set regEx = CreateObject("VBScript.RegExp")

↑ここでは何をやっているかというと、処理の中で使う、ファイルシステムオブジェクトと正規表現オブジェクトを生成しています。↓処理の最後の方で出てくる(4)´(オブジェクトの解放)と対になっています。

    Set regEx = Nothing                                            '……(4)´
    Set FSO = Nothing

    stPath = WScript.Arguments(0)                                 '……(5)

↑ここでは何をやっているかというと、このVBSを起動するときに必ず引数を1つ与えることにしているのですが、その引数を受け取っています。

この部分はVBEでデバッグするときには使えないので、VBSにしていからテストしました。

    txtStrm = txtReadAll(stPath, FSO)                             '……(6)

↑ここでは何をやっているかというと、引数で与えられたファイルパスをもとに、テキストファイルを一度に全部読み込む関数txtReadAllを呼び出しています。

txtReadAll関数というのはこちら↓です。

Private Function txtReadAll(ByRef stPath, ByRef FSO)
    
    
    ' ファイルを読み取り専用で読み込み
    Dim stream
    Set stream = FSO.OpenTextFile(stPath, 1)
    
    ' テキストファイルの一括読み込み
    txtReadAll = stream.ReadAll
    
    ' テキストファイルを閉じる
    stream.Close
    Set stream = Nothing
    

End Function

↑特にこの関数については解説しませんが、コメント読めばだいたいやっていることは分かりますよね。

    Call findReplace(txtStrm, regEx, "[0-9０-９,.,．]", wdWidthFullWidth)       '……(7)'

↑ここでは何をやっているかというと、読み込んだテキストをFindReplace関数に渡して編集しています。

最初に全角する1桁の数字を正規表現で検索しています。

この処理の後、txtStrmに入っていた文字列の中の数字はいったん全部全角になります。2桁以上の数字も全部全角です。

    Call findReplace(txtStrm, regEx, "[0-9０-９,.,．]{2,}", wdWidthHalfWidth)   '……(8)'

↑ここでは何をやっているかというと、txtStrmに含まれる2桁以上の数字を半角に変換しています。

    Call txtWriteAll(txtStrm, stPath, FSO)                         '……(9)

↑ここでは何をやっているかというと、編集が終わったtxtStrmを引数で与えられたパスのファイルに書き戻しています。

txtWriteAll関数というのはこちら↓です。

Private Sub txtWriteAll(ByRef txtStrm, ByRef stPath, ByRef FSO)
    Dim stream
    Set stream = FSO.OpenTextFile(stPath, 2)
    ' 書き込み
    Call stream.Write(txtStrm)

    ' ファイルクローズ
    stream.Close
    
    Set stream = Nothing
End Sub

↑コメントを読めばだいたい処理の内容が分かると思うので、解説はいらないと思います。

    WScript.Quit                                                   '……(10)

↑ここでは何をやっているかというと、スクリプトを終わらせています。ここでQuitをやっておかないと、この後のSubやFunctionに制御が移ってしまうのです。これはVBS特有の制御なのかもしれません。

Private Sub findReplace( _
         ByRef txtStrm, _
         ByRef regEx, _
         ByRef stText, _
         ByRef wWidth)
                                                                 '……(11)    
    Dim stRet, Matches, vStrm
    
    '正規表現の各種設定
    regEx.Pattern = stText      'パターン
    regEx.IgnoreCase = True     '大文字と小文字を区別しない
    regEx.Global = True         '文字列全体を検索する
    
    vStrm = txtStrm
    
    Set Matches = regEx.Execute(vStrm)

↑ここからfindReplace関数の説明をします。VBSでは引数も型指定はしません。引数はすべてByRef参照としていますが、意味があるのはtxtStrmだけで、あとはメモリの節約のためにByRef参照としているだけです。ByVal参照にしても構わないのですが、今回はなんとなくByRef参照で統一しました。

VBAだとFindのプロパティを大量に指定する必要がありましたが、VBSの正規表現ではIgnoreCaseとGlobalだけです。

vStrmというのは、最初はtxtStrmと同じ長さ、同じ内容なんですが、この後のループの中でどんどん短くなっていく文字列です。常にLeft関数で切り出すために、ヒットした文字列のすぐ後ろから切り出すように制御されています。最終的に、正規表現でヒットしなくなった文字列だけが残ります。

regEx.Execute(vStrm)で1回目の検索を実行しています。正規表現での検索では実はこの1回で全部の条件に合致する項目が取得できてしまいますが、制御の都合上、Matchesコレクションの先頭Itemしか使っていません。その代わり、検索してもヒットしなくなるまで、何回も正規表現による検索が続けられます(検索対象となるvStrmはループの中でどんどん文字列の長さが短くなっていきます)。

    Do While Matches.Count > 0                                   '……(12)'

↑これが、検索してもヒットしなくなるまでループしなさいという条件部分です。

考え方としてはWord版と同様です。Word版の方があらかじめいろいろ用意されているのでコード数は短くなりますが、VBSでも同じことをやっています。要は、ヒットした箇所一つ一つ丁寧に半角か全角か変換しているのです。

        Set Matches = regEx.Execute(vStrm)                       '……(13)'

↑ここでは何をやっているかというと、ループの中での検索実行です。この引数のvStrmの中身は、(11)での検索のときより短くなっています。

免責事項

ここで紹介したコードをあなたがお使いになるのは自由ですが、それによって大切なデータが破壊されたり、取り返しのつかない事態になったとしても当方では責任は一切負えません。あらかじめデータをセーブしておくなど、自己責任でお使いください。

またコードについては十分にテストしたつもりですが、万が一バグや不具合があっても当方ではあなたの都合のよいときに対応することはできません。メールなどで教えていただければ、私の都合のよいときに私にとって都合のよい形でコードを修正することはあるかもしれませんが、コードの修正を必ずお約束するものではありません。

なお、ここで掲示したコードをお使いになるのは自由ですが、私は著作権までは放棄していません。

まとめ

以上、VBSで1桁の数字を全角に、2桁以上の数字を半角に変換する方法を紹介しました。

何かのお役に立てば幸いです。

ここまでお読みくださりありがとうございました。

前の記事

労働義務に付随する義務について【社実研より】 2022.10.06
次の記事

賃金支払の五原則【一定期日払】 2022.10.08

【VBS】1桁の数字を全角に、2桁以上の数字を半角に変換するには

VBSのコード

使い方

コードの解説

免責事項

まとめ

労働義務に付随する義務について【社実研より】 2022.10.06

賃金支払の五原則【一定期日払】 2022.10.08

RANKING

【Excel】PowerQueryで正規表現を使う方法【M式言語】

照合省略と17条付記

【Mac】マウス操作を自動化するツール【Automator】

【外国人技能実習生】国民年金の免除申請について【入国後講習中】

ブラウザもSeleniumも使わずExcelVBAでスクレイピング

フォルダ配下(サブフォルダも)ファイル一覧を取得するには【CMD】【ExcelVBA】

VBAで開いたフォルダをVBAで閉じるには

【VBA】クラスモジュールの使いどころーコレクションで使う―

照合省略(17条の付記)にかかる労働局からの通知が来ました。

【SeleniumBasic】地図の距離と時間を取得する【Excel】