Excel VBAで文字コード表を作る(UTF-8編)

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

事例iにするテーマを決めて、その機能を実現するためのコーディングを動く形でお示しています。

今回は前回に引き続き、「Excel VBAで文字コード表を作る」がテーマになります。
前回は「SHIFT-JISの文字コード表」でしたが、今回は「UTF-8の文字コード表」をご紹介いたします。

SHIFT-JISは1～2バイトで文字を表すコード体系でしたが、UTF-8は1～4バイト(体系上は最大6バイトまで[次章参照])で文字をコード付けしているために、かなり多くの文字を扱う事ができます。

そのために今回のコーティング事例はかなり長いものになっていますので、あらかじめお含み置きいただければ幸いです。

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

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

UTF-8(Unicode Transformation Format-8)とは

筆者は文字コード体系の詳細についてほとんど存じ上げておりません。

という事で詳細につきましては下記「IT用語辞書e-Words」のページをご参照いただければ幸いです。

UTF-8とは - IT用語辞典

UTF-8とは、Unicodeで定義された文字集合を表現することができる文字コード(符号化方式)の一つ。一文字を1〜6バイトの可変長で表現するもので、様々な言語の文字を扱える文字コ...

e-words.jp

ここに書かれている内容を、かいつまんでまとめると次のようになる認識です。

• Unicode（ユニコード）はUnicodeコンソーシアムが策定している多言語文字コードの規格で、UCS(Universal multi-octet Character Set)とは、この規格をISO及びIECが公式に標準化したもの。
• Unicodeでは文字にそれぞれ固有の識別番号である「コードポイント」（符号位置）を付与しているが、この値をビット列として表現する規則の事を文字符号化方式（符号化スキーム）と呼ぶ。
• UTF-8は複数存在する文字符号化方式の中で、実用上はもっとも広く普及している。
• 一つの文字を最大6バイトまでの可変長のバイト列で表現するが、実際には4バイト以下の文字が大半

UTF-8文字コード表のコード範囲

各バイト数で「どのようなコード範囲に文字が割り当てられているか?」に関しても筆者は知識がある分けではないので、有識者の皆様のサイトを参考にしてコード範囲を決めています。
この場を借りて御礼を申し上げます。

参照いたしましたサイトは下記の2つになります。

• なお両者に違いがある時は範囲が広い方を採用しています。
• 割り当てられている「文字の種類」は、区切りとして考慮していませんのであらかじめお含み置きください。
• コーディングをする際には空白範囲(文字が割り当てられていない範囲)を考慮して、その範囲は出力しないように考慮しています。
  • ただし、各バイト数で、1から3バイトでは最後のバイトに未使用箇所があったとしても、それはそのまま処理をしています。
  • 4バイトにつきしては、3バイト目に未使用箇所があったとしても、そのまま処理をしています。

コード範囲は下記表のように設定しています。

1バイト目上位4ビットは「C～D」
1バイト目下位4ビットの基本は「0～F」

1バイト目の上位4ビットは「E」
2バイト目の上位4ビットの基本は「8～B」

1バイト目の上位4ビットは「F」
2バイト目の上位4ビットの基本は「8～B」
3バイト目の上位4ビットの基本は「8～B」

コーディングの際の考慮点

考慮しなければならない点は複数ありますので、順を追ってご説明いたします。

なお前回ご説明した仕様につきましては、下記のリンクをご参照いただければ幸いです。

• ADO(ActiveX Data Objects)のStreamオブジェクトを使う
  • UTF-8の文字コードを文字に変換するためにはADOのStreamオブジェクトを使用した、ユーザ関数「AdoStrmConv」を使用しています。コーディング事例は上記リンク先の章の中に掲載しております。
  • 前回ご説明していなかった「未使用箇所のおかしな文字イメージ」につきましては、後段でご説明いたします。
• Execlのシートで文字コード表を作成する際の仕様
  • 前回は「16行×16列のマトリクスの形で文字コード表を作成」しましたが、今回は文字コードのバイト数によって縦列の数は変わります。
    　1バイト文字→16行×7列
    　2～4バイト文字→16行×4列
  • 文字コードを「HyperlinkコレクションのAddメソッド」でハイパーリンクを設定して、Hyperlink.ScreenTipプロパティとして表示するのですが、このやり方では1シートに設定できる文字数に上限がありました。SHIFT-JISの場合はこの上限には引っかからなかったのですが、詳細は後述いたします。

未使用箇所をどのように回避するのか?

コーディングの仕方は色々とある事と存じますが、前章でご紹介したように4バイト文字では様々な範囲が多数存在しているために、今回はFor文で範囲を設定するのは最小限に留めています。

この理由としては下記になります。

• 未使用範囲が飛び飛びに表れる事になり、範囲の連続性が見た目では判断できなくなってしまう。
  • 今回のコーティング事例では飛ばした範囲のヘッダー行に文字コードを残すようにしています。
• For文の数が多くなり、コーディング量も多くなってしまうので、もう少しコンパクトに圧縮したかったためです。

そこでFor文で回す中で、未使用範囲については文字コードの中の1～2バイト(1.5バイトも含みます)を配列にセットして、Filter関数を使って省略するようにしています。

未使用範囲はかなり多くに別れて存在しているので、配列の要素数はその分設定していますのであらかじめお含み置きください。

1シートに設定できるハイパーリンクの上限について

今回初めて1つのシートに大量の文字コードを出力することになったのですが、その時に下記のエラーが発生しました。

エラーメッセージの内容も、エラーが発生する場所もFor文の中なので「なぜエラーになるのか?」分からなかったのですが。調べている内にMicrosoftコミュニティの下記Q&Aページにたどり着きました。

Excel2010で65,530個を超えるハイパーリンクは挿入できない

Excel 2010 で マクロを使ってハイパーリンクを挿入すると、ハイパーリンクの挿入数が 65,530を超えると挿入できずにエラーになる、これは Excel の仕様でしょうか？

answers.microsoft.com

2014年1月の投稿なので、昔ら設定され続けている上限のようです。

今回ご紹介するコーディング事例では、1つのシートにセットしたハイパーリンクの数が65,530を超えそうになった時は、簡易的に1度だけ新しいシートに遷移するようにしています。

例えば4バイト文字を例に挙げると、3文字目と4文字目が0x8080から0xBFBFまですべて出力されるとすると、文字コードの数は4,096になります。

それに加えて2文字目が仮に0x8/0～Fまで使用されている場合は4,096×16=65,536となり、これだけで上限を超えてしまいますので注意が必要です。

未使用箇所の「おかしな文字イメージ」

「おかしな文字イメージ」をご説明する前に、前回ご紹介したユーザ関数「AdoStrmConv」ではどのような戻り値が返るのか?についてはご説明していませんでしたので、こちらを先にご説明いたします。

ユーザ関数「AdoStrmConv」の戻り値はバイナリ配列

このユーザ関数は、ADOのStreamオブジェクトからReadTextメソッドを使用して読み取ったデータを返します。

ちなみにバイナリ型のストリーム (Type が adTypeBinary) の場合は、Readメソッドを使用します。
下記Microsoft Officeアドインのドキュメントをご参照いただければ幸いです。

ReadText メソッド (ADO)

Office 開発者クライアント VBA リファレンス ドキュメント

learn.microsoft.com

ここでご注意いただきたいのは、Streamオブジェクトは「データのバイナリ ストリーム」なので、ReadTextメソッドの結果もバイナリ配列として返されています。

実際にどのような値が返っているか?については、つぎのようなコーディングで調べる事ができます。

Sub ReturnCodeCheck()
Dim by_rtn() As Byte, by_buf(0 To 2) As Byte
Dim st_rtn As String, i As Integer
Const stMOJICD As String = "UTF-8"
    by_buf(0) = Val("&HEF")
    by_buf(1) = Val("&HBC")
    by_buf(2) = Val("&HA1")
    by_rtn() = AdoStrmConv(by_buf, stMOJICD)
    For i = 0 To UBound(by_rtn): st_rtn = st_rtn & by_rtn(i) & " ": Next i
    Debug.Print st_rtn & "→[" & AdoStrmConv(by_buf, stMOJICD) & "]"
End Sub

5～7行目で指定しているUTF.8の3バイト文字コードは”0xEFBCA1″ですが、これは全角大文字の「Ａ」になります。
上記に加えて文字コード”0xEFBCA2″(全角大文字「Ｂ」)も続けて実行した結果は次のようになります。

33 255 →[Ａ]34 255 →[Ｂ]

文字コードでは3バイト目がインクリメントされていますが、戻り値のバイト配列は1バイト目がインクリメントされます。
このようにバイト配列の中には、数値情報がセットされている事がお分かりいただけると存じます。

この戻り値のバイト配列は何を表しているのか?

筆者はこの辺りの動きについて知識がないので想像にはなりる事お許しください。

恐らく『OS(筆者のパソコンはWindows OS)にこのバイト配列の数値情報が渡されると、OSがOSに設定されている文字コードの中から該当コードの文字イメージを引き出して返してきます。
それをアプリケーションであるExcelが受け取り、Excelに指定されているフォント形式などの加工を施して画面に表示させているのではないか?』と思います。

かく言う筆者もこれを調べる前までは、文字イメージが返るものだとばかり思っていましたが…そのために『「おかしな文字」が返されたら空文字に置き換えよう』なんて考えたりしたのですが、そんなことは実現不可能でした。

「おかしな文字イメージ」はExcelでは表示する場所によって異なる

Excelで作成した文字コード表果を眺めていると気付くのですが、この「おかしな文字イメージ」は数パターン存在していて一種類ではありません。

しかも表示される場所を調べて行くと、①数式バーでの表示、②セルでの表示、③「ハイパーリンクの編集」の表示文字列での表示、それぞれでバラバラになっている事が分かりました。

バラバラというのは、例えば次のような文字コードでのケースになります。(弊社検証パソコンでの結果なので、環境によっては違ったものになるかもしれません)

1. 0xF0908A80
   ①と③は正しい文字だが、②だけおかしい文字

2. 0xE0A2A0
   ①②③とも正しい文字。ただし①は数式バーの右端に表示される。

3. 0xE0A080
   正しい文字はなし。②と③は同じようなおかしな文字で①は別物

4. 0xF3A08080
   正しい文字はなし。①、②は同じおかしな文字。③は3.と同じおかしな文字

目に留まったものをピックアップしただけなので、他にもいろいろなバリエーションや他の場所でも違いがあるのかもしれません。

恐らくはExcelは歴史の長いソフトウェアであるために、また下位互換を考慮している面もあるので、一貫性を求めるのが難いのかもしれません。

なお、こうして見ると③のおかしな文字は、①や②に比べると一貫性がありそうに見えます。(ハイパーリンクは他に比べると後から開発された機能のはずです)

ただこれ以上詮索しても無駄なので、このような状況である事をお伝えするまでに留めさせていただきます。

実際のコーディング事例

ザックリとしたコーディンクの内容を下記に列挙いたします。

• 文字コードを出力する先は、前回と同様に開いているExcelブックにシートを追加して行いますが、1つのシートにセットしたハイパーリンクの数が65,530を超えそうになった時は、簡易的に1度だけ新しいシートに遷移するようにしています。
• 1バイト文字から順番に4バイト文字までをコンスタント変数iOUTFLGに下記の数値1文字をセットすることで出力する対象を選択します。
  • 1：1バイト文字、2：2バイト文字、3：3バイト文字、9：1から3バイト文字
  • 4バイト文字はコード範囲が広いために上位2バイトで、次の5つに分けています。
    • 4：0xF090～0xF09F
    • 5：0xF0A0～0xF0B1
    • 6：0xF3A0(弊社環境では文字の出力はなし)
    • 7：0xF3B0～0xF3BF(弊社環境では文字の出力はなし)
    • 8：0xF480～0xF48F(弊社環境では文字の出力はなし)
• 3バイト文字、4バイト文字には未使用範囲を省略するための配列を指定しています。
  • 前章「UTF-8文字コード表のコード範囲」よりも多い省略範囲を指定していますが、皆様の環境に合わせて選択していただければ幸いです。
    • コンスタント変数iOUTFLGが「4 or 5 or 7 or 8」の時は、省略範囲が無指定だと1シートに収まらないのでご注意ください。
• 4バイト文字ではFor文を使った未使用範囲の省略をしています。そのために 子サブルーチンutf8sub4を作っています。

Sub utf8()
Dim i As Integer, i1 As Integer, i2 As Integer, i3 As Integer, i4 As Integer, j As Integer, k As Integer
Dim st_cd As String, st_cell As String
Dim l_cd As Long
Dim i_row As Integer, i_col As Integer
Dim st_rtn As String, st_chk As String, st_chk3_3 As String
Dim v_omit3_3 As Variant, v_omit3 As Variant, v_omit2 As Variant
Dim by_buf() As Byte
Dim ws As Worksheet, st_wsCnt As String, l_lnk As Long
'--------------------------------
Const stMOJICD As String = "UTF-8"
Const iOUTFLG As Integer = 3    '1:1バイト,2:2バイト,3:3バイト,4:4バイト1,5:4バイト2,6:4バイト3,7:4バイト4,8:4バイト5,9:1から3
Dim dbl_t As Double
    dbl_t = Timer  '経過時間表示のために開始時刻をセット
    Application.ScreenUpdating = False  '画面固定
    Set ws = Sheets.Add(after:=Sheets(Sheets.Count))  '新しいシートを右端に追加
    st_wsCnt = ""
    i_row = 1 '最初の行
    If iOUTFLG = 1 Or iOUTFLG = 9 Then  '出力判定
'1バイト文字
        ReDim by_buf(0)
        ws.Columns("A:Q").Font.Size = 12  'フォントの大きさ
        ws.Cells(1, 1).Value = "0x": ws.Cells(1, 1).Font.Size = 14  'タイトル左端の表記
        For i = 0 To 15: ws.Cells(1, i + 2).Value = "〃_" & Hex(i): Next i '列タイトルセット
        Range(ws.Cells(1, 2), ws.Cells(1, 17)).Interior.ColorIndex = 34 ' 列タイトル背景を色付け
        st_cell = ws.Cells(1, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False) 'リンク先セルを保存
        For i1 = Val("&H0") To Val("&H7")  '上位4ビット
            i_col = 1  '最初の列
            i_row = i_row + 1
            ws.Cells(i_row, i_col).Value = "〃" & Right("0" & Hex(i1), 1) & "_"  '行タイトルセット
            ws.Cells(i_row, i_col).Interior.ColorIndex = 34 '行タイトル背景を色付け
            For i2 = Val("&H0") To Val("&HF")  '下位4ビット
                i_col = i_col + 1
                l_cd = i1 * 16 + i2  '16進上位4ビットと下位4ビットを合わせて10進変換
                st_cd = Right("00" & Hex(l_cd), 2)  '16進表記
                by_buf(0) = Val("&H" & Hex(l_cd))  'バイト配列に10進数でセット
                ws.Cells(i_row, i_col).Value = AdoStrmConv(by_buf, stMOJICD)
                If l_cd = 39 Then  'l_cd = 39 はシングルコーテーションの10進表記
                    ws.Cells(i_row, i_col).Value = "''"  'シングルコーテーション×2
                ElseIf ws.Cells(i_row, i_col).Value = vbNullChar Or ws.Cells(i_row, i_col).Value = "" Then
                    ws.Cells(i_row, i_col).Value = Chr(39) & ws.Cells(i_row, i_col).Value  'NullCharと空文字には「'」を付ける
                End If
                'シート内セルを飛び先にしたハイパーリンク設定。ヒント表示で16進表記を見せる
                ws.Hyperlinks.Add anchor:=ws.Cells(i_row, i_col), Address:="", SubAddress:=st_cell, ScreenTip:=st_cd
            Next i2
        Next i1
    End If
    If iOUTFLG = 2 Or iOUTFLG = 9 Then  '出力判定
'2バイト文字
        ReDim by_buf(1)
        For i1 = Val("&HC2") To Val("&HDF") '1バイト目
            If i_row <> 1 Then i_row = i_row + 1
            st_chk = Hex(i1)  '1バイト目の16進数
            ws.Cells(i_row, 1).Value = "0x" & st_chk: ws.Cells(i_row, 1).Font.Size = 14  '1バイト目を左隅にセット
            For i = 0 To 15: ws.Cells(i_row, i + 2).Value = "〃_" & Hex(i): Next i  '列タイトルセット
            Range(ws.Cells(i_row, 2), ws.Cells(i_row, 17)).Interior.ColorIndex = 34 ' 列タイトル行の色付け
            '↓ハイパーリンクの飛び先(タイトル行の左上端)セルを保存
            st_cell = ws.Cells(i_row, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
            For j = Val("&H80") To Val("&HB0") Step 16  '2バイト目。ステップを16に設定
                i_col = 1  '最初の列
                i_row = i_row + 1
                ws.Cells(i_row, i_col).Value = "〃" & Left(Hex(j), 1) & "_"  '行タイトルセット
                ws.Cells(i_row, i_col).Interior.ColorIndex = 34 ' 行タイトルに色付け
                For i2 = j To (j + 15)  '&H0~&HF
                    i_col = i_col + 1
                    l_cd = 16& ^ 2 * i1 + i2  '16進1バイト目と2バイト目を合わせて10進変換
                    st_cd = Hex(l_cd)  '16進表記
                    by_buf(0) = Val("&H" & Hex(i1))
                    by_buf(1) = Val("&H" & Hex(i2))
                    ws.Cells(i_row, i_col).Value = AdoStrmConv(by_buf, stMOJICD)
                    ws.Hyperlinks.Add anchor:=ws.Cells(i_row, i_col), Address:="", SubAddress:=st_cell, ScreenTip:=st_cd
                Next i2
                i_col = 1
            Next j
        Next i1
    End If
    If iOUTFLG = 3 Or iOUTFLG = 9 Then  '出力判定
'3バイト文字　  ↓表示を省略する1バイト目と2バイト目上位4ビットの16進数
        v_omit3_3 = Array("E08", "E09", "EDA", "EDB", "EE8", "EE9", "EEA", "EEB", "EF8", "EF9")
        v_omit3 = Array("EFA0", "EFA1", "EFA2", "EFA3")  '←表示を省略する1バイト目と2バイト目の16進数
        ReDim by_buf(2)
        For i1 = Val("&HE0") To Val("&HEF")
            For j = Val("&H80") To Val("&HB0") Step 16  '2バイト目。ステップを16に設定
                st_chk3_3 = Left(Hex(16& ^ 4 * i1 + 16& ^ 2& * j), 3)  '1~2バイト目の16進表記の左から3文字
                st_rtn = Filter(v_omit3_3, st_chk3_3)  '1バイト目と2バイト目上位4ビットで除外対象かの判定
                If UBound(st_rtn) <> -1 Then  '戻り値が配列になっている場合は除外対象
                    If i_row > 2 Then i_row = i_row + 1
                    ws.Cells(i_row, 1).Value = "0x" & st_chk3_3: ws.Cells(i_row, 1).Font.Size = 14  '1~2バイト目を左隅にセット
                    For i = 0 To 15: ws.Cells(i_row, i + 2).Value = "〃_" & Hex(i): Next i  '列タイトルセット
                    Range(ws.Cells(i_row, 2), ws.Cells(i_row, 17)).Interior.ColorIndex = 34 ' 列タイトル行の色付け
                    If i_row = 1 Then i_row = i_row + 1
                Else
                    For i2 = j To (j + 15)  '&H0~&HF 2バイト目下位4ビット
                        i_row = i_row + 1
                        st_chk = Left(Hex(16& ^ 4 * i1 + 16& ^ 2& * i2), 4) '1~2バイト目の16進数
                        ws.Cells(i_row, 1).Value = "0x" & st_chk: ws.Cells(i_row, 1).Font.Size = 14  '1~2バイト目を左隅にセット
                        For i = 0 To 15: ws.Cells(i_row, i + 2).Value = "〃_" & Hex(i): Next i  '列タイトルセット
                        Range(ws.Cells(i_row, 2), ws.Cells(i_row, 17)).Interior.ColorIndex = 34 ' 列タイトル行の色付け
                        '↓ハイパーリンクの飛び先(タイトル行の左上端)セルを保存
                        st_cell = ws.Cells(i_row, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                        st_rtn = Filter(v_omit3, st_chk)  '1バイト目と2バイト目で除外対象かの判定
                        If UBound(st_rtn) = -1 Then  '戻り値が配列になっていないので対象
                            i_col = 1
                            For k = Val("&H80") To Val("&HB0") Step 16  '3バイト目上位4ビット。ステップを16に設定
                                i_row = i_row + 1
                                ws.Cells(i_row, i_col).Value = "〃" & Left(Hex(k), 1) & "_" '行タイトルセット
                                ws.Cells(i_row, i_col).Interior.ColorIndex = 34 ' 行タイトルに色付け
                                For i3 = k To (k + 15)  '&H0~&HF 3バイト目下位4ビット
                                    i_col = i_col + 1
                                    l_cd = 16& ^ 4 * i1 + 16& ^ 2& * i2 + i3   '16進1~3バイト目を合わせて10進変換
                                    st_cd = Hex(l_cd)    '16進表記
                                    by_buf(0) = Val("&H" & Hex(i1))
                                    by_buf(1) = Val("&H" & Hex(i2))
                                    by_buf(2) = Val("&H" & Hex(i3))
                                    ws.Cells(i_row, i_col).Value = AdoStrmConv(by_buf, stMOJICD)
                                    ws.Hyperlinks.Add anchor:=ws.Cells(i_row, i_col), Address:="", SubAddress:=st_cell, ScreenTip:=st_cd
                                Next i3
                                i_col = 1
                            Next k
                        End If
                    Next i2
                End If
            Next j
        Next i1
    End If
    l_lnk = 0  'ハイパーリンクの数をカウント
    If iOUTFLG = 4 Then   '出力判定
'4バイト文字 その1
        For i1 = Val("&HF0") To Val("&HF0")  ''1バイト目
            For i2 = Val("&H90") To Val("&H9F")  '2バイト目
                Call utf8sub4(i1, i2, i_row, stMOJICD, iOUTFLG, ws, st_wsCnt, l_lnk)
            Next i2
        Next i1
    ElseIf iOUTFLG = 5 Then  '出力判定
'4バイト文字 その2
        For i1 = Val("&HF0") To Val("&HF0")  ''1バイト目
            For i2 = Val("&HA0") To Val("&HB1")  '2バイト目
                Call utf8sub4(i1, i2, i_row, stMOJICD, iOUTFLG, ws, st_wsCnt, l_lnk)
            Next i2
        Next i1
    ElseIf iOUTFLG = 6 Then  '出力判定
'4バイト文字 その3
        For i1 = Val("&HF3") To Val("&HF3")  ''1バイト目
            For i2 = Val("&HA0") To Val("&HA0")  '2バイト目
                Call utf8sub4(i1, i2, i_row, stMOJICD, iOUTFLG, ws, st_wsCnt, l_lnk)
            Next i2
        Next i1
    ElseIf iOUTFLG = 7 Then  '出力判定
'4バイト文字 その4
        For i1 = Val("&HF3") To Val("&HF3")  ''1バイト目
            For i2 = Val("&HB0") To Val("&HBF")  '2バイト目
                Call utf8sub4(i1, i2, i_row, stMOJICD, iOUTFLG, ws, st_wsCnt, l_lnk)
            Next i2
        Next i1
    ElseIf iOUTFLG = 8 Then  '出力判定
'4バイト文字 その5
        For i1 = Val("&HF4") To Val("&HF4")  ''1バイト目
            For i2 = Val("&H80") To Val("&H8F")  '2バイト目
                Call utf8sub4(i1, i2, i_row, stMOJICD, iOUTFLG, ws, st_wsCnt, l_lnk)
            Next i2
        Next i1
    End If
    ws.Name = stMOJICD & "." & iOUTFLG & st_wsCnt  'シート名を変更
    ws.Columns("A:Q").HorizontalAlignment = xlCenter  '横配置
    ws.Columns("A:Q").VerticalAlignment = xlCenter  '縦配置
    ws.Columns("A").EntireColumn.AutoFit  '列幅を自動調整
    ws.Columns("B:Q").ColumnWidth = 5  '列幅を設定
    ws.Cells(1, 1).Select  'A1セルを選択して範囲選択を解消
    Set ws = Nothing
    Application.ScreenUpdating = True  '画面固定を解除
    MsgBox (Timer - dbl_t) & " 秒"
End Sub

Sub utf8sub4(i1s As Integer, i2s As Integer, irow As Integer, stMOJICDs As String, iOUTFLGs As Integer, wss As Worksheet, stwsCnt As String, llnk As Long)
Dim st_chk As String, st_chk3_3 As String, v_rtn As Variant
Dim st_cd As String, st_cell As String
Dim i As Integer, j As Integer, k As Integer
Dim i3 As Integer, i4 As Integer
Dim i_col As Integer
Dim l_cd As Long
Dim by_buf(3) As Byte
Dim v_omit2 As Variant
Dim v_omit3_3s As Variant, v_omit3s As Variant
    If iOUTFLGs = 4 Then   '出力判定
'4バイト文字 その1
        v_omit2 = Array("95", "97", "98", "99", "9A", "9C")  '←表示を省略する2バイト目の16進数
        '↓表示を省略する2バイト目と3バイト目上位4ビットの16進数
        v_omit3_3s = Array("91B", "92A", "92B", "93A", "93B", "948", "94A", "94B", "968", "969", "9B9", "9BA", "9DB", "9E8", "9E9", "9FB")
        '↓表示を省略する2バイト目と3バイト目の16進数
        v_omit3s = Array("9088", "9089", _
                            "9096", "9097", "909E", "909F", _
                            "90A5", "90AF", _
                            "90B4", "90B5", "90B6", "90B7", "90B8", "90BA", "90BB", "90BC", "90BD", "90BE", _
                            "918E", "918F", _
                            "9190", "9191", "9194", "9195", "919D", "919E", "919F", _
                            "91A0", "91A1", "91A4", "91A5", "91A6", "91A7", "91A8", "91A9", "91AA", "91AC", "91AD", "91AE", "91AF", _
                            "9296", "9297", "9298", "9299", "929A", "929B", "929C", "929D", "929E", "929F", _
                            "9391", "9392", "9393", "9394", "9395", "9396", "9397", "9398", "9399", "939A", "939B", "939C", "939D", "939E", "939F", _
                            "949A", "949B", "949C", "949D", "949E", "949F", _
                            "96AA", "96AF", _
                            "96B0", "96B1", "96B2", "96B3", "96B4", "96B5", "96B6", "96B7", "96B8", "96B9", "96BA", "96BB", _
                            "9B84", "9B85", "9B86", "9B87", "9B88", "9B89", "9B8A", "9B8B", "9B8C", "9B8D", "9B8E", "9B8F", _
                            "9BB3", "9BB4", "9BB5", "9BB6", "9BB7", "9BB8", "9BB9", "9BBA", "9BBB", "9BBC", "9BBD", "9BBE", _
                            "9D8A", "9D8B", "9D8E", "9D8F", _
                            "9DAB", "9DAC", "9DAD", "9DAE", "9DAF", _
                            "9EA6", "9EA7", "9EA8", "9EA9", "9EAA", "9EAB", "9EAC", "9EAD", "9EAE", "9EAF", _
                            "9EB0", "9EB1", "9EB2", "9EB3", "9EB4", "9EB5", "9EB6", "9EB7", "9EBC", "9EBD", "9EBE", _
                            "9FA8", "9FAC", "9FAD", "9FAE", "9FAF")
    ElseIf iOUTFLGs = 5 Then
'4バイト文字 その2
        v_omit2 = Array("")
        v_omit3_3s = Array("AD8", "ADA", "ADB", "AEA", "AEB", "AF8", "AF9", "AFB")
        v_omit3s = Array("ABA1", "ABA3", "ABA4", "ABA5", "ABA6", "ABA7", "ABA8", "ABA9", "ABAA", "ABAC", "ABAF", _
                            "ABB1", "ABB2", "ABB3", "ABB4", "ABB9", "ABBA", "ABBB", "ABBC", "ABBD", "ABBE", _
                            "AC81", "AC84", "AC85", "AC86", "AC88", "AC8B", "AC8E", "AC8F", _
                            "AC90", "AC91", "AC93", "AC94", "AC96", "AC97", "AC9A", "AC9B", "AC9D", _
                            "ACA0", "ACA1", "ACA2", "ACA5", "ACA6", "ACA7", "ACAB", _
                            "ACB0", "ACB2", "ACB5", "ACBB", "ACBC", "ACBD", "ACBE", _
                            "AD90", "AD91", "AD92", "AD93", "AD94", "AD96", "AD97", "AD98", "AD99", "AD9A", "AD9B", "AD9C", "AD9D", "AD9E", "AD9F", _
                            "AE80", "AE81", "AE82", "AE83", "AE84", "AE85", "AE86", "AE87", "AE88", "AE8A", "AE8B", "AE8C", "AE8D", "AE8E", "AE8F", _
                            "AE90", "AE91", "AE92", "AE93", "AE94", "AE96", "AE97", "AE98", "AE99", "AE9A", "AE9C", "AE9D", "AE9E", "AE9F", _
                            "AFA8", "AFA9", "AFAA", "AFAB", "AFAC", "AFAD", "AFAE", "AFAF")
    ElseIf iOUTFLGs >= 6 Then
'4バイト文字 その3~5
        v_omit2 = Array("")
        v_omit3_3s = Array("")
        v_omit3s = Array("")
    End If
    st_chk = Hex(i2s)  '2バイト目の16進表記
    v_rtn = Filter(v_omit2, st_chk)
    If UBound(v_rtn) <> -1 Then  '戻り値が配列になっている場合は除外対象
        If irow <> 1 Then irow = irow + 1
        wss.Cells(irow, 1).Value = "0x" & Hex(i1s) & st_chk: wss.Cells(irow, 1).Font.Size = 14  '1・2バイト目を左隅にセット
        For i = 0 To 15: wss.Cells(irow, i + 2).Value = "〃___" & Hex(i): Next i  '列タイトルセット
        Range(wss.Cells(irow, 2), wss.Cells(irow, 17)).Interior.ColorIndex = 37 ' 列タイトル行の色付け
    Else
        For j = Val("&H80") To Val("&HB0") Step 16  '3バイト目。ステップを16に設定
            st_chk3_3 = Left(Hex(16& ^ 4 * i2s + 16& ^ 2& * j), 3)  '2~3バイト目の16進表記の左から3文字
            v_rtn = Filter(v_omit3_3s, st_chk3_3)    '1バイト目の&HF0は含めない
            If UBound(v_rtn) <> -1 Then  '戻り値が配列になっていない。ので対象
                If irow <> 1 Then irow = irow + 1
                wss.Cells(irow, 1).Value = "0x" & Hex(i1s) & st_chk3_3: wss.Cells(irow, 1).Font.Size = 14  '1~3バイト目を左隅にセット
                For i = 0 To 15: wss.Cells(irow, i + 2).Value = "〃_" & Hex(i): Next i  '列タイトルセット
                Range(wss.Cells(irow, 2), wss.Cells(irow, 17)).Interior.ColorIndex = 34 ' 列タイトル行の色付け
            Else
                For i3 = j To (j + 15)  '&H0~&HF 3バイト目下位4ビット
                    If irow <> 1 Then irow = irow + 1
                    st_chk = Left(Hex(16& ^ 4 * i2s + 16& ^ 2& * i3), 4) '2~4バイト目の16進数
                    wss.Cells(irow, 1).Value = "0x" & Hex(i1s) & st_chk: wss.Cells(irow, 1).Font.Size = 14  '1~4バイト目を左隅にセット  1バイト目を付けたし
                    For i = 0 To 15: wss.Cells(irow, i + 2).Value = "〃_" & Hex(i): Next i  '列タイトルセット
                    Range(wss.Cells(irow, 2), wss.Cells(irow, 17)).Interior.ColorIndex = 34 ' 列タイトル行の色付け
                    '↓ハイパーリンクの飛び先(タイトル行の左上端)セルを保存
                    st_cell = wss.Cells(irow, 1).Address(RowAbsolute:=False, ColumnAbsolute:=False)
                    v_rtn = Filter(v_omit3s, st_chk)  '2バイト目と3バイト目で除外対象かの判定
                    If UBound(v_rtn) = -1 Then  '戻り値が配列になっていないので対象
                        i_col = 1
                        For k = Val("&H80") To Val("&HB0") Step 16  '4バイト目。ステップを16に設定
                            irow = irow + 1
                            wss.Cells(irow, i_col).Value = "〃" & Left(Hex(k), 1) & "_" '行タイトルセット
                            wss.Cells(irow, i_col).Interior.ColorIndex = 34 ' 行タイトルに色付け
                            For i4 = k To (k + 15)  '&H0~&HF 4バイト目下位4ビット
                                i_col = i_col + 1   '↓Hexの上限は20億だが4バイト文字は上限を超えるので1バイト目は含めない
                                l_cd = 16& ^ 4 * i2s + 16& ^ 2& * i3 + i4   '16進2~4バイト目を合わせて10進変換
                                st_cd = Hex(i1s) & Hex(l_cd)  '1バイト目を付けたし
                                by_buf(0) = Val("&H" & Hex(i1s))
                                by_buf(1) = Val("&H" & Hex(i2s))
                                by_buf(2) = Val("&H" & Hex(i3))
                                by_buf(3) = Val("&H" & Hex(i4))
                                wss.Cells(irow, i_col).Value = AdoStrmConv(by_buf, stMOJICDs)
                                wss.Hyperlinks.Add anchor:=wss.Cells(irow, i_col), Address:="", SubAddress:=st_cell, ScreenTip:=st_cd
                                llnk = llnk + 1
                            Next i4
                            i_col = 1
                        Next k
                        If llnk + 64 > 65530 Then
                            wss.Name = stMOJICDs & "." & iOUTFLGs & stwsCnt  'シート名を変更
                            wss.Columns("A:Q").HorizontalAlignment = xlCenter  '横配置
                            wss.Columns("A:Q").VerticalAlignment = xlCenter  '縦配置
                            wss.Columns("A").EntireColumn.AutoFit  '列幅を自動調整
                            wss.Columns("B:Q").ColumnWidth = 5  '列幅を設定
                            wss.Cells(1, 1).Select  'A1セルを選択して範囲選択を解消
                            Set wss = Nothing
                            Set wss = Sheets.Add(after:=Sheets(Sheets.Count))  '新しいシートを右端に追加
                            irow = 1 '最初の行
                            stwsCnt = stwsCnt & "1"
                            llnk = 0
                        End If
                    End If
                Next i3
            End If
        Next j
    End If
End Sub

※実行するには上記以外に、前回コーディンク事例をご紹介したユーザ関数「AdoStrmConv」が必要になりますので、ご注意ください。

※3バイト文字の0xEFBBBFはまったくの空文字になるために、正しくハイパーリンクを表示する事ができません。

※弊社検証パソコンでは、コンスタント変数iOUTFLGが7の時の処理時間は20秒弱でした。

最後に

今回は「UTF-8の文字コード表を作る」をテーマにご説明してきました。

記事の中でお話した 「おかしな文字イメージ」の事は、今まで気づいていなかったので少し驚きでしたが、実害がある分けではないので、優先度が低い課題なのかもしれません…

次回は、前回と今回で得た情報を元に「バイナリーエディタ」をVBAで作成したいと思います。

「バイナリーエディタ」で文字コード変換をする事にどれだけ意味があるか?は解らないのですが、バイナリース情報の中に2バイト以上の文字コードが含まれているか?を調べたいという思いは理解できます。

この際に、SHIFT-JISで解析するか?UTF-8で解析するか?によって見え方は変わってくるので、次回も2回に分けてご説明する予定です。

以上、最後までご一読いただき誠にありがとうございました。