VBAでバイナリビューアの作成

VBAを使って、セル上にバイナリファイルを展開します。

バイナリファイルを読み込んでみる
以下のコードは、ファイルをバイナリ形式でセル上に展開します。

Option Explicit

Sub ReadBinary2()
    Dim myByte As Byte
    Dim myRange As Range
    Dim myFileName As String
    Dim r As Long
    Dim c As Long
    
    'セルのエラーを無視、セルの初期化
    Application.ErrorCheckingOptions.BackgroundChecking = False
    Set myRange = Range("A2").End(xlDown)
    Range(Cells(2, 1), Cells(myRange.Row, 34)).Clear
    'ファイルを開く
    ChDir ThisWorkbook.Path & "\"
    myFileName = Application.GetOpenFilename()
    Open myFileName For Binary As #1
    
    Cells(2, 1).Value = "'000000"
    Cells(2, 1).Interior.Color = RGB(192, 192, 192)
    r = 2
    c = 2
    'バイナリファイルを読み込みつつセルに書き込み
    Do While Not EOF(1)
        Get #1, , myByte
        Cells(r, c).Value = "'" & _
 CStr(Application.WorksheetFunction.Dec2Hex(myByte, 2))
        Cells(r, c).HorizontalAlignment = xlCenter
        c = c + 1
        
        If c >= 18 Then
            c = 2
            r = r + 1
            '左端の番地名
            Cells(r, 1).Value = "'" & _
 CStr(Application.WorksheetFunction.Dec2Hex((r - 2) * 16, 6))
            Cells(r, 1).Interior.Color = RGB(192, 192, 192)
        End If
    Loop
    Close #1
    
    c = c - 1
    If c = 1 Then
        c = 17
        r = r - 1
    End If
    '文字コードに対応する文字を表示
    Range(Cells(2, 19), Cells(r, 34)).Value = "=CHAR(HEX2DEC(B2))"
    If c <> 17 Then
    Range(Cells(r, c + 18), Cells(r, 34)).Clear
    End If
    
End Sub

バイナリで指定してファイルを開き、Getで1バイトずつ読み込みセルに書き込む作業を繰り返しています。
セルに書き込む際に時間を取るため、100kB程度のファイルでも展開に30秒ほどかかってしまいます。一度、配列にいれてから、配列ごとセルに書き込むと時間短縮になりますが、1セルずつ書き込まれていくの姿がかっこいいのでこのままで。