Excel VBAでバイナリーエディタを作る(SHIFT-JIS編)

Excel VBAのコーディング事例をご紹介しています。

事例iにするテーマを決めて、その機能を実現するためのコーディングを動く形でお示していますが、今回と次回は、2回に渡り「Excel VBAでバイナリーエディタを作る」をテーマといたします。

なお2回に分けているのは、今回が「SHIFT-JIS編」、次回が「UTF-8編」にしているためです。

「バイナリーエディタを作る」ためのコーディング自体はほぼほぼ同じなのですが、それぞれのコード体系の違いを実装する部分が大きく異なるので、分けざるを得ない認識です。

コーディング自体は「構造化・標準化は考慮しつつも極力コーディング量は減らし、その上で可読性を維持する」という思いは持ちつつも「テーマに沿って動くことを優先して実装」しています。

※動作は32bit版Excel 2016と64bit版Excel 2021の バージョン2303(ビルド 16227.20280)を使用して検証しています。

バイナリーエディタとは

ご存じのようファイルには「バイナリファイル」と「テキストファイル」の2種類があり、バイナリーエディタは『「バイナリファイル」を開くためのツールである』と考えるのが一般的です。

ただOS上にあるファイルはバイナリ形式で保存されているので、「テキストファイル」をバイナリーエディタで開く事はできますが、「テキストファイル」専用のエディタに比べると単なる文字の羅列にしかならないので、使われる事は無いと存じます。

今回バイナリーエディタを作るに当たり機能と外観を決める必要があるのですが、あまり奇をてらっても使い難い物になってしまうので、良く使われている形を参考にしています。

コアな機能

バイナリーエディタのコアな部分の機能は下記のようになる認識です。

本当にコアな機能だけになりますが、今回はこの形で実装する事にします。

バイナリーエディタの外観

今回参考にいたしましたバイナリーエディタ―は2000年以前に作られたStirling(スターリング)です。

1999年06月にリリースされたVer.1.31が最新盤になりますが、Windows11でも動きます。

上図のようなStirling(スターリング)の外観を参考にして、『「16進表記」は左側、「指定された文字コードに変換した表記」は右側にして、1行は16文字で表示する』形式を採用いたします。
※なおStirling(スターリング)では指定する文字コードを変更する事ができますが(その中にUTF8は無)、VBAでその機能を実装しようとすると長くなってしまうので、UTF8編はそれ専用のコーディング事例といたします。

その他にもStirling(スターリング)の次のような機能を参考にしています。

これらの特徴も参考にいたしました。

Excel VBAで実装するための考慮点

Excel VBAで実装にするにあたり、「どこでどのような機能を使うか?」は色々とバリエーションがある事と存じます。

今回は次の2つのメインサブルーチンを作る形で考えています。
※2つの他にも子サブルーチンや子ファンクションなどが存在しますのでご注意ください。

1. ファイルを選択してバイナリ配列に読み込み「16進表記」と「指定された文字コードに変換した表記(以下 Shift-JIS表記)」をセットするサブルーチン
2. セルにセットされた文字にフォーカスが当たると、「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配列をファイルに保存する子サブルーチン

まずは読み込みからですが、コーディングで使用しているコンスタント変数を先にご説明いたします。

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 = "ＭＳ ゴシック"
        .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編についてご紹介いたします。

以上最後までご一読いただき誠に有難うございました。