Excel VBAのコーディング事例をご紹介しています。
事例iにするテーマを決めて、その機能を実現するためのコーディングを動く形でお示していますが、今回と次回は、2回に渡り「Excel VBAでバイナリーエディタを作る」をテーマといたします。
なお2回に分けているのは、今回が「SHIFT-JIS編」、次回が「UTF-8編」にしているためです。
「バイナリーエディタを作る」ためのコーディング自体はほぼほぼ同じなのですが、それぞれのコード体系の違いを実装する部分が大きく異なるので、分けざるを得ない認識です。
コーディング自体は「構造化・標準化は考慮しつつも極力コーディング量は減らし、その上で可読性を維持する」という思いは持ちつつも「テーマに沿って動くことを優先して実装」しています。
※動作は32bit版Excel 2016と64bit版Excel 2021の バージョン2303(ビルド 16227.20280)を使用して検証しています。
バイナリーエディタとは
ご存じのようファイルには「バイナリファイル」と「テキストファイル」の2種類があり、バイナリーエディタは『「バイナリファイル」を開くためのツールである』と考えるのが一般的です。
ただOS上にあるファイルはバイナリ形式で保存されているので、「テキストファイル」をバイナリーエディタで開く事はできますが、「テキストファイル」専用のエディタに比べると単なる文字の羅列にしかならないので、使われる事は無いと存じます。
今回バイナリーエディタを作るに当たり機能と外観を決める必要があるのですが、あまり奇をてらっても使い難い物になってしまうので、良く使われている形を参考にしています。
コアな機能
バイナリーエディタのコアな部分の機能は下記のようになる認識です。
- OS上に置かれているファイルを1つ選択して、バイナリ形式で読み込み、それを「16進表記」と「指定された文字コードに変換した表記」で対比して表示する。
- 「16進表記」は左側、「指定された文字コードに変換した表記」を右側に表記する形式が公開されているバイナリーエディタではほとんどです。
- 16進表記のデータ内容は修正する事ができる。
- 修正したデータをバイナリ形式で保存する事ができる。
本当にコアな機能だけになりますが、今回はこの形で実装する事にします。
バイナリーエディタの外観
今回参考にいたしましたバイナリーエディタ―は2000年以前に作られたStirling(スターリング)です。
1999年06月にリリースされたVer.1.31が最新盤になりますが、Windows11でも動きます。
上図のようなStirling(スターリング)の外観を参考にして、『「16進表記」は左側、「指定された文字コードに変換した表記」は右側にして、1行は16文字で表示する』形式を採用いたします。
※なおStirling(スターリング)では指定する文字コードを変更する事ができますが(その中にUTF8は無)、VBAでその機能を実装しようとすると長くなってしまうので、UTF8編はそれ専用のコーディング事例といたします。
その他にもStirling(スターリング)の次のような機能を参考にしています。
- 「16進表記」の文字にフォーカスが当たると、「指定された文字コードに変換した表記」の当該箇所にも印が表示される。
- 逆パターンでも同様な動きをします。
- 左端の列に16進表記で列番号を表記する
これらの特徴も参考にいたしました。
Excel VBAで実装するための考慮点
Excel VBAで実装にするにあたり、「どこでどのような機能を使うか?」は色々とバリエーションがある事と存じます。
今回は次の2つのメインサブルーチンを作る形で考えています。
※2つの他にも子サブルーチンや子ファンクションなどが存在しますのでご注意ください。
- ファイルを選択してバイナリ配列に読み込み「16進表記」と「指定された文字コードに変換した表記(以下 Shift-JIS表記)」をセットするサブルーチン
- セルにセットされた文字にフォーカスが当たると、「16進表記」と「Shift-JIS表記」それぞれでの該当する場所に印を付けるサブルーチン
2.はWorksheetオブジェクトのSelectionChangeイベントにコーディングする事で、ワークシートの選択範囲が変更されたら時にお互いの印の位置を変える事ができるようになります。
ただしWorksheetオブジェクトにコーディングをセットするためには、追加したシートに後から動的にコーディングを付け足す事はできません。
※セキュリティの事を考えると動的コーディングはできなくて正解です。(昔はできたりしましたが…)
そこであらかじめコーディングをセットした「雛形シート」を作成して置いて、それをコピーする事でこの課題を解決しています。
なお「雛形シート」にすべてのコーディングをセットしておくと後々管理が大変になるので、「雛形シート」には標準モジュールにセットしたサブルーチンをコールするだけのコーディングをするようにしています。
1.ファイルをバイナリ配列に読み込み「16進」と「Shift-JIS」で表記する
このサブルーチンでの考慮点は次のようになります。
- ファイルを指定したら、「雛形シート」をコピーしてシート名を読みんだファイルのファイル名に変更します。
- ファイル名はパスは取り除き、拡張子はそのままセットします。
- 「16進表記」と「Shift-JIS表記」は「一文字づつ一つのセルに格納」します。
- Shift-JIS表記ではChr関数で文字コード変換をします。
- ただし1文字づつ格納をすると都度ワークシートを呼び出す事になるのでタイムロスが生じます。
そこで1行分を16進表記とShift-JIS表記それぞれで変数に1文字はダブルクォーテーション付きのタブ区切りでセットして、1行分が溜まったらそのデータをワークシートの各行の先頭列のセルにまとめてセットするようにします。 - すべてのデータが処理し終わったら、最後に先頭列のセルをすべて選択してTextToColumns メソッドを使用してTSVデータをタブで分解し文字列として各列にセットします。
- この方法であれば「データがシングルコーテーションの場合でも正しくセットされる」などの利点があります。
- 特定の文字コードではShift-JIS表記はChr関数の戻り値ではないものをセットします。
- 次の文字コードでは文字が返らないので”.”(ピリオド)をセットします。
- 0x00~0x1F、0x7F、0x80、0xA0~0xFD
- 次の文字コードでは文字が返らないので”.”(ピリオド)をセットします。
- Shift-JIS表記では2バイト文字は1カラム目には2バイト文字をセットし、2カラム目は空文字をセットします。
- 16文字目が2バイト文字になった時は、次の行のShift-JIS表記の1文字目は空文字をセットします。
- データがダブルクォーテーションの場合はVBAで扱える形に加工してセットします。
- 最後にデータがセットされたすべてのセル範囲を選択状態にします。
【すべてのセル範囲を選択状態にする理由と対処方法】
実際に実行すると、多くのセルにエラーインジケータが表示される事になりますが、表示を消すためには「エラーを無視する」操作が必要です。
そのために最後にデータがセットされたすべての範囲を選択するようにコーディングしています。
- 選択された状態であればワークシートにフォーカスが当たると、エラーインジケータは下図のように表示されているはずです。
- そこでエラーインジケータにフォーカスを当てて下矢印を表示させてクリックし、次にサブメニューの「エリーを無視する」をクリックしてください。
2.「16進表記」と「Shift-JIS表記」それぞれでの該当する場所に印を付ける
WorksheetオブジェクトのSelectionChangeイベントには、標準モジュールに記述したサブルーチンを呼び出すようにコーディングします。
- SelectionChangeイベントはアクティブ ワークシートでフォーカスを持ったカレント セルが変更された時に毎回呼び出されますが、複数セル選択されている場合は処理はスルーします。
- 変更される前にカレント セルには背景色が付いた状態なので、それを消去する必要がありますが、今回はセル位置の情報を保持するのではなく、背景色を付ける列は決まっているので、その決まった範囲のカラムすべての列の背景色をクリアするようにします。
※従いまして消去対象範囲で背景色を設定してもクリアされてしまいますのでご注意ください。 - カレント セルが背景色を付ける対象の範囲でない時はスルーします。
- 「2バイト文字か?」を判断するやり方として、今回は「16進表記」ではなく「Shift-JIS表記」の方を見て、カレント セルの文字が2バイト文字であるか?を判定します。
- Shift-JIS文字コードの場合、対象の文字をStrConv関数を使って引数にvbFromUnicodeを指定して一旦既定のコード ページに変換してから、LenB関数を使用して長さを調べる事ができます。
- Microsoft Officeサポート「LEN 関数、LENB 関数」の「重要」で書かれている下記記述をご参照ください。
- LENB関数では、既定の言語としてDBCS言語が設定されている場合にのみ、1 文字が2バイトとしてカウントされます。
- DBCS:”double byte character set”
- 1バイト文字は1セル、2バイト文字は2セルの背景色を設定します。
- 2バイト文字の16文字目が2バイト文字になった時は、「16進表記」と「Shift-JIS表記」ともに次の行の1文字目の背景色を設定します。
実際のコーディング事例
まずは「SJIS雛形」というシート名でシートを作成して、そのシートのWorksheetオブジェクトのSelectionChangeイベントに次のようなコーディングをします。
Private Sub Worksheet_SelectionChange(ByVal Target As Range) Call BianaryEditorSkinSJis(Target) End Sub
上記を呼び出している「BianaryEditorSkinSJis」は標準モジュールに次のようにコーディングします。
Public Sub BianaryEditorSkinSJis(rTarget As Range) Dim l_col As Long, l_row As Long Application.ScreenUpdating = False '画面固定 If rTarget.CountLarge > 1 Then Exit Sub '複数セル選択はスルー Columns("B:AG").Interior.ColorIndex = 0 ' 対象列の背景色をクリア l_row = 0: l_col = 0 With rTarget If .Column >= 2 And .Column <= 17 Then '16進表記の列範囲 .Interior.ColorIndex = 20 .Offset(0, 16).Interior.ColorIndex = 20 If LenB(StrConv(.Offset(0, 16).Value, vbFromUnicode)) = 2 Then '2バイト文字の時 If .Column = 17 Then '16番目の時は2文字目は次の行での出力に l_row = 1: l_col = 16 End If .Offset(l_row, 17 - l_col).Interior.ColorIndex = 20 .Offset(l_row, 1 - l_col).Interior.ColorIndex = 20 End If ElseIf (.Column >= 18 And .Column <= 33) Then 'Shift-JIS表記の列範囲 .Interior.ColorIndex = 20 .Offset(0, -16).Interior.ColorIndex = 20 If LenB(StrConv(.Value, vbFromUnicode)) = 2 Then '2バイト文字の時 If .Column = 33 Then '16番目の時は2文字目は次の行での出力に l_row = 1: l_col = 16 End If .Offset(l_row, 1 - l_col).Interior.ColorIndex = 20 .Offset(l_row, -15 - l_col).Interior.ColorIndex = 20 End If End If End With Application.ScreenUpdating = True '画面固定解除 End Sub
次に今回のメインサブルーチンになりますが、ファイルの読み込みと書出しのサブルーチンは別々にコーディングしています。
合わせて次のような子ファンクションと子サブルーチンも使用しています。
- ファイルをBinary配列に一括読み込みする子ファンクション
- Binary配列をファイルに保存する子サブルーチン
まずは読み込みからですが、コーディングで使用しているコンスタント変数を先にご説明いたします。
- 13行目のコンスタント変数「HINAGATA」に雛形シート名をセットします。
- 下記では「SJIS雛形」をセットしています。
- 14行目のコンスタント変数「stDEFAULT」にはファイルを開く際のデフォルトパスをセットします。
- 下記では「C:\Users」をセットしています。
Private Sub BinaryEditorReadSjis() Dim st_FilePathName As String 'バイナリファイルパスとファイル名 Dim st_FileName As String Dim fn As Integer 'ファイル番号 Dim by_Ary() As Byte '読み込みデータ配列 Dim l_Size As Long 'ファイルサイズ Dim l As Long, i As Integer Dim l_row As Long, l_col As Long Dim st_Hex As String, st_Hex1 As String, st_Byte As String Dim st_tsv As String, st_tsv1 As String, st_tsv2 As String Dim b_flg As Boolean '------------------------------------------------------------------- Const HINAGATA As String = "SJIS雛形" 'ひな形シート名を設定 Const stDEFAULT As String = "C:\Users" '必要がある時にパスのデフォルト設定をします Dim dbl_t As Double 'ファイルパスとファイル名の設定・取得 st_FilePathName = stDEFAULT If Len(chooseFolder(st_FilePathName)) = 0 Then MsgBox "ファイルが選択されていません。" Exit Sub '<<<<<<<< End If ' l_Size = ReadFileBianary(st_FilePathName, by_Ary) If l_Size = 0 Then MsgBox "ファイルを読み込めませんでしたん。" Exit Sub '<<<<<<<< End If ' dbl_t = Timer st_FileName = Mid(st_FilePathName, InStrRev(st_FilePathName, Chr(92)) + 1) 'フルパスからファイル名取得 Application.ScreenUpdating = False '画面固定 Worksheets(HINAGATA).Copy after:=Sheets(Sheets.Count) 'ひな形シートをコピー With ActiveSheet .Name = st_FileName 'シート名をファイル名に変更 '初期設定 l = 0 'バイナリ配列の添え字をリセット l_row = 1: l_col = 0 '行番号:列番号をリセット st_tsv = "": st_tsv1 = "": st_tsv2 = "" '1行を書き出す変数:16進コード書出し変数:Shift-JIS表示書出し変数 b_flg = False '16文字目が2バイトコードだったかをハンドリング Do st_Hex = Right("00" & Hex(by_Ary(l)), 2) 'バイナリ配列の文字を一個づつHex関数で処理 l_col = l_col + 1 st_tsv1 = st_tsv1 & st_Hex & vbTab '文字コード書出し変数に1行16列をタブ区切りでまとめて設定 If b_flg Then '前行の16文字目が2バイト文字の1バイト目だったら st_Byte = """""" '2バイト文字の2バイト目はダブルクォーテーション×2の空文字 b_flg = False 'フラグをリセット ElseIf st_Hex <= "1F" Or st_Hex = "7F" Or st_Hex = "80" Or st_Hex = "A0" Or st_Hex >= "FD" Then st_Byte = """" & "." & """" '文字がセットされていない文字コード ElseIf (st_Hex >= "81" And st_Hex <= "9F") Or (st_Hex >= "E0" And st_Hex <= "FC") Then '2バイト文字の1バイト目 If l >= l_Size - 1 Then 'バイナリ配列の終端の時は次の文字コードが無いのでピリオドに st_Byte = """" & "." & """" Else st_Hex1 = Right("00" & Hex(by_Ary(l + 1)), 2) 'バイナリ配列の次の文字を取得 If (st_Hex1 >= "40" And st_Hex1 <= "7E") Or (st_Hex1 >= "80" And st_Hex1 <= "FC") Then '2バイト文字の2バイト目 st_Byte = """" & Chr(by_Ary(l) * 256& + by_Ary(l + 1)) & """" 'Chr関数でShift-JIS2バイト文字に変換 If l_col < 16 Then '16列のまとめに未到達 l_col = l_col + 1 st_tsv1 = st_tsv1 & st_Hex1 & vbTab st_Byte = st_Byte & vbTab & """""" '2バイト文字の2バイト目はダブルクォーテーション×2の空文字 l = l + 1 '添え字のカウントアップ Else b_flg = True '16列まとめの最後が2バイト文字だった事をフラグに設定 End If Else '2バイト文字以外はピリオド st_Byte = """" & "." & """" End If End If Else '2バイト文字以外の文字コード st_Byte = """" & Chr(by_Ary(l)) & """" End If If st_Hex = "22" Then 'ダブルクォーテーション(")だったら st_tsv2 = st_tsv2 & """""""""" & vbTab 'ダブルクォーテーション(")×2をダブルクォーテーションで括る Else st_tsv2 = st_tsv2 & st_Byte & vbTab 'Shift-JIS表示書出し変数に1行16列をタブ区切りでまとめて設定 End If If l_col >= 16 Then '列カウンタが16以上になっていたらセルにデータを出力 st_tsv = st_tsv & """" & Right("00000000" & Hex(l - 15), 8) & """" & vbTab '行番 st_tsv = st_tsv & st_tsv1 '最後はタブなので、そのままにする st_tsv = st_tsv & Left(st_tsv2, Len(st_tsv2) - 1) 'Shift-JIS表示の行末のタブは除外 .Cells(l_row, 1).Value = st_tsv l_col = 0: st_tsv = "": st_tsv1 = "": st_tsv2 = "" '各種変数の初期化 l_row = l_row + 1 '行番号をカウントアップ End If l = l + 1 '添え字のカウントアップ If l > l_Size - 1 Then Exit Do 'ループエンド <<<<<<<< Loop If st_tsv1 <> "" Then '一番最後のデータを出力 st_tsv = st_tsv & """" & Right("00000000" & Hex(l - 15), 8) & """" & vbTab '行番 For i = l_col + 1 To 16 '1行に足りないカラムを付けたし st_tsv1 = st_tsv1 & vbTab st_tsv2 = st_tsv2 & """""" & vbTab 'ダブルクォーテーション×2で空文字 Next st_tsv = st_tsv & st_tsv1 st_tsv = st_tsv & Left(st_tsv2, Len(st_tsv2) - 1) 'Shift-JIS表示の行末のタブは除外 .Cells(l_row, 1).Value = st_tsv End If '文字コードのTSVデータをタブで分解して文字列として各列にセット .Cells(1, 1).Select 'A1セルを選択 Range(Selection, Selection.End(xlDown)).Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=1, Tab:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2), Array(3, 2), _ Array(4, 2), Array(5, 2), Array(6, 2), Array(7, 2), Array(8, 2), Array(9, 2), Array(10, 2), Array(11, 2), Array(12, 2), Array(13, 2), Array(14, 2), Array(15, 2), Array(16, 2), _ Array(17, 2), Array(18, 2), Array(19, 2), Array(20, 2), Array(21, 2), Array(22, 2), Array(23, 2), Array(24, 2), Array(25, 2), Array(26, 2), Array(27, 2), Array(28, 2), _ Array(29, 2), Array(30, 2), Array(31, 2), Array(32, 2), Array(33, 2)) '書式設定 .Columns("A:AG").Font.Name = "MS ゴシック" .Columns("A:AG").EntireColumn.AutoFit '列の幅を自動調整 .Columns("R:AG").ColumnWidth = 1 'Shift-JIS表示の列幅を再設定 .UsedRange.Select '全選択 End With Application.ScreenUpdating = True '画面固定を解除 MsgBox (Timer - dbl_t) & " 秒" End Sub
次に書出しです。
※出力先はコーディングを保存したExcelマクロ有効ブックの置き場所と同じフォルダーにして、ファイル名は読み取り時にシート名に設定したものを使用しています。
Private Sub BinaryEditorWrite() Dim by_Ary() As Byte 'バイナリファイルとして書出しするバイト配列 Dim l As Long, lMax As Long, lcnt As Long Dim i As Integer Dim l_Size As Long Dim st_FileName As String Dim dbl_t As Double dbl_t = Timer With ActiveSheet lMax = .Cells(Rows.Count, 2).End(xlUp).Row '2列目にDataが入っている最終行 For i = 1 To 16 '最終行はどこまでカラムが埋まっているか取得 If IsNull(.Cells(lMax, i + 1).Value) Or .Cells(lMax, i + 1).Value = "" Then Exit For '<<<<<<<< Next l_Size = (lMax - 1) * 16 + i - 1 '出力するデータのバイト数を計算 ReDim by_Ary(l_Size - 1) 'バイト配列の添え字を再定義 lcnt = 0 For l = 1 To lMax - 1 '最終行-1まで出力 For i = 1 To 16 by_Ary(lcnt) = Val("&H" & .Cells(l, i + 1).Value) '16進を10進変換してバイト配列にセット lcnt = lcnt + 1 Next i Next l For i = 1 To 16 '最終行を出力 by_Ary(lcnt) = Val("&H" & .Cells(lMax, i + 1).Value) '16進を10進変換 lcnt = lcnt + 1 If IsNull(.Cells(lMax, (i + 1) + 1).Value) Or .Cells(lMax, (i + 1) + 1).Value = "" Then Exit For '<<<<<<<< Next i '現在のブックのパスとシート名から出力するファイル名をセット st_FileName = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) & .Name End With Call WriteFileBianary(st_FileName, by_Ary) MsgBox (Timer - dbl_t) & " 秒" End Sub
最後は読み取り時の子ファンクションと書き込み時の子サブルーチンになります。
Private Function ReadFileBianary(stFilename As String, ByRef bytbuf() As Byte) As Long Dim fn As Integer ReadFileBianary = 0 fn = FreeFile 'ファイル番号取得 Open stFilename For Binary Access Read As #fn 'ファイルオープン ReadFileBianary = LOF(fn) 'ファイルサイズ取得 ReDim bytbuf(ReadFileBianary) '配列の領域確保 bytbuf = InputB(ReadFileBianary, fn) 'データをバイナリ配列に一括読み込み Close #fn 'ファイルクローズ End Function
Private Sub WriteFileBianary(stFilename As String, bytbuf() As Byte) Dim fn As Integer fn = FreeFile Open stFilename For Binary Access Write As #fn Seek #fn, LOF(fn) + 1& Put #fn, , bytbuf Close #fn End Sub
Exccelシートの中にバイナリーファイルを格納できる事の危険性
今回の記事をご一読いただくと気付かれるように、Excelシートの中にバイナリーファイルを格納する事ができてしまいます。
当然今回の形に留まらず、さまざまな形に変えて格納する事ができるはずです。
これはある意味「危険性がある話」で、例えば隠しシートや、セルの非表示の場所にバイナリーデータを潜ませされた状態で、悪意のあるVBAマクロを起動してしまうとマルウェアに感染してしまうかもしれません。
このような場合は、当然Excelブックのファイルサイズがある程度大きくなっているはずですので、ファイルサイズに違和感を感じる事ができれば隠された悪意に気付けるかもしれませんが…
Excelでは、このような危険性を発見し処置するためのツール「ドキュメントの検査」を提供してくれています。
呼び出し方はつぎのようになります。
「ファイル」メニュータブ→「情報」サイドバー→「ブックの検査」→「ドキュメントの検査」
なぜこのツールの中の、スクロールした最後の方に「ヘッダーとフッター」、「非表示の行と列」、「非表示のワークシート」、「非表示のコンテンツ」などのように「良く使用するものがなぜ存在しているのか?」と疑問に思われる方もいらっしゃるかもしれません。
それは実はこのような場所にバイナリーファイルを格納する事ができてしまうためですので、十分にご注意ください。
最後に
今回はExcel VBAでバイナリーエディタを作るのSHIFT-JIS編をご紹介いたしました。
バイナリファイルをShift-JIS文字コードに変換する事の必要性につきましては議論の分かれるところであると存じます。
ただ「どのような2バイト文字の情報が含まれているのか?を判読したい」と思う気持ちは分かりますし、先人達が作られたツールでも実装されてきているのは事実です。
ところで、今回のコーディングを実際に実行した時に、どのくらい時間が必要になるのか?は気になるところだと思います。
そこでC:\Windowsディレクトリにある「regedit.exe サイズ:552,960バイト」を実行した時のキャプチャを掲載いたします。
弊社パソコン環境では約21秒かかりましたが、最終行は34,560行となり16文字目まで0x00がセットされていました。
念のためバイト数を計算すると、エクスプローラーに表示されるバイト数と同じになりました。
34,560行×16バイト=552,960バイト
話を戻しますが、1秒あたりの読み込みバイト数は下記になります。
552,960バイト÷21秒=26.331.429バイト/秒
Stirling(スターリング)とは比べ物にならないのですが、1MByteぐらいのサイズであれば1分はかからない事になるので、場合によって利用できるようなシートもあるかもしれません…
またStirling(スターリング)との2バイト文字の表示のされ方の違いも気になるところだと思います。
ただStirling(スターリング)が2000年が最後の更新であるためにShift-JISコードの新しい情報は反映されていないと思われます。
実際にregedit.exeのデータを見ていると次のような箇所が見つかります。
上図の文字コード「0xF185」をSHIFT-JIS文字コード表で出力させてみると、Excelのセル表示では一番右の図のように「おかしな文字」として表示されています。
※「おかしな文字」につきましてはUTF-8の場合ではありますが、「Excel VBAで文字コード表を作る(UTF-8編)」の記事をご参照いただければ幸いです。
なお「おかしな文字」の現象はShift-JISの場合でもUTF-8の時と同じように起こります。
ただそれが今回のコーディングの実行結果では正しい文字としてセルに表示されています。
この理由は正確には解らないのですが、もしかするとTextToColumns メソッドを使用してセルにセットした場合には「おかしな文字」にならないのかもしれません…
次回はバイナリーエディタのUTF8編についてご紹介いたします。
以上最後までご一読いただき誠に有難うございました。