Excel VBA UTF-8 Decode セルの文字をUTF-8の16進コードポイントに分解する

1.[注意]Excel 2013以降

WorksheetFunction Unicodeを使用するので、これ以前のバージョンでは動かない。
https://stackoverflow.com/questions/29980993/how-can-i-decode-utf8-in-visual-basic-6#30085572
代替する方法としてはこちらのUTF8Encode関数とByte飛ばし、戻しが必要となるかもしれない。

作動原理

1文字かどうか

まずLenで1文字かどうかを確認する。
1文字はそのままExcel.WorksheetFunction.Unicode関数に代入する。

3文字かどうか

3文字であればIVSとして扱う。
この時1、3に分解してExit Forで狩猟する。

サロゲートペア（代用対）か

1度そのままUnicodeに入れて65536(&H10000)を超える場合はサロゲートとして扱う。

4文字より大きいか

この時は結合文字が入っているとしてLenを最大値とする。
そしてこの時はMid関数で文字を分解する。

さらにLenが奇数

この時も結合文字が入っているとして扱う。
そしてこの時はMIDで文字を分解する。
これ以外はMIDBです。

この判定は最大値とMid　MidBの選択に影響する。

MidBまたはMidで分解し、Worksheetfunction.Unicode関数に入れる

Step2 で回すが、MidBだとUnicode関数は勝手に1か2を判定しているようだ。
Emojiはこれが原因でエラーになるらしい。このときMidに変える。

文字化けしていてもコードが拾える

当方の環境では
タピオカドリンク🧋はFireFoxでは🧋表示、Chromeでは&#1F9CB;文字化け、Excel（Segoe UI Emoji)では文字化けする。
しかしFireFoxで表示してExcelのセルにコピペすると拾える。

WorksheetFunction.Unicode関数の無双

https://blog.docurain.jp/entry/20210502/1619954644
ここで紹介されている女性農家を例にとる。
UTF-8は
👩‍🌾 は UTF-8は👩‍🌾である。
👩 👩このあとに結合文字zwjが入っている。
単純にUnicode関数で変換すると両者はともに128105になる。つまり最初の1文字だけ拾っている。

しかしVBAでMIDと組み合わせると

ところがVBAでは切れ味が鋭くなります。
この文字はLENで5文字と判定されます。
For NextはStep2ですので、iは1，3，5と増加する。
ここで、Midで切ると3文字目はゼロ幅文字列と🌾🌾の前半の0.5文字分というおかしな値になる。
しかしUnicode関数は勝手にゼロ幅文字列に変えてしまう。
さらに5文字目は🌾🌾の後半の0.5文字分である。
ところが、今度はUnicode関数は勝手に4文字目から変換する。
このため、Byte飛ばし、スライドのような手間が必要ない。
この現象はMidBでは発生しない。

Excel.WorksheetFunction.Unicodeの公式には説明がないので将来動作が変わるかもしれない

テキストの先頭文字に対応した数値 (コード ポイント) を返します。

公式の説明にはなにも書いていない。なので将来仕様が変わる可能性がある。

AscWとの比較

Sub 文字コード番号を調べる_A1セル()

と比較すると複雑だが、やはりLENとMIDと組み合わせている点は間違いないようだ。
なおこの記事はUTF-16LEになっている。（ただしひっくり返していない）
また、マイナスの時の処理がない。
ついでに言うとAscWの公式の説明はExcelのところに記載されていない。

AscBとの比較

reliefの記事を以下のように変える。
https://learn.microsoft.com/ja-jp/dotnet/api/microsoft.visualbasic.strings.ascw?view=net-7.0

以前のバージョンの Visual Basic の関数は AscB 、文字ではなくバイトのコードを返します。 それは主に、2 バイト文字セット (DBCS) アプリケーションで文字列を変換するために使用します。 すべての Visual Basic 2005 文字列は Unicode に含まれており AscB はサポートされなくなりました

Sub 文字コード番号を調べる_Qiita_Q11Q()
  Dim txt As String
  Dim i As Long, c As String
  txt = ActiveCell.Text
  For i = 1 To LenB(txt)
    c = MidB(txt, i, 1) ' MidBに変更
    Debug.Print c; AscB(c); Hex(AscB(c)) ' AscBに変更
  Next
  
End Sub

?-10179 D83D
?-9111 DC69
? 8205 200D
?-10180 D83C
?-8386 DF3E
 1  61 3D
 2  216 D8
 3  105 69
 4  220 DC
 5  13 D
 6  32 20
 7  60 3C
 8  216 D8
 9  62 3E
 10  223 DF

reliefのコードと、AscBとMidBを組み合わせた結果を比較すると3D D8 つまりUTF-16LEのまま、反対になっている。
またAscWもzwjでずれても勝手に判断して調整しているようだ。
つまりUnicode関数はUTF-8のコードポイント、AscWはUTF-16LEのコードポイントを返していることがわかる。
AscBはUTF-16LEのコードをそのまま（つまりD83Dを3D D8）反対にして出力している。
AscBはひっくり返しと0埋め(D->0D)が必要だが、AscWは必要ない。また一度に出力される。
Range.Text プロパティ (Excel)
しかし、ここは書式付きテキストではなくてもいいのではないかと思うが表示形式を考慮しているようだ。

AccessはAscWで出力している

今回のきっかけはAccessでテーブルやクエリを出力すると文字化けすることが発端だった。
しかし、AscWによって出力（ただしマイナスの場合は65536を加算）していると結論できるようだ。
AccessでHTMLで出力される変な文字化けはShift-Jisを超えた範囲の文字を次のようなアルゴリズムで出力してるからだろう。

Sub AccessUnicodeHTMLString()
' Excel VBA
' ActivecellのUTF-16LEのコードポイントを返す
  Dim txt As String
  Dim rst As String
  txt = ActiveCell.Text
  
  Dim i As Long, c As String
  For i = 1 To Len(txt)
    rst = rst & "&#" & IIf(AscW(c) < 0, AscW(c) + 65536, AscW(c)) & ";"
  Next
  Debug.Print rst
End Sub

これで前回のUTF-16LEのUCS4Stringに入れる配列はできる
だが、UTF-8の方は全部というわけにはいかなかった。
😑と👩‍🌾と👩🏿‍❤️‍💋‍👨🏼の🌸
"D83D","DE11","3068","D83D","DC69","200D","D83C","DF3E","3068","D83D","DC69","D83C","DFFF","200D","2764","FE0F","200D","D83D","DC8B","200D","D83D","DC68","D83C","DFFC","306E","D83C","DF38"
Accessで成功するかは不明だが、とにかくこういう配列になるだろう。
��と��‍��と����‍❤️‍��‍����の��
しかしUTF-8はおかしい。
😑と�🌾と��❤‍�👨🏼の�
素直に変換するとここでおかしくなる。
😑と
まではうまくいくのだが次の絵文字はコードがおかしくなる。
この後が1F469のはずがDC69になって失敗している。
今回はここは不明だった。

Sub AccessUnicodeHTMLString()
' Excel VBA
' Activecellの最初の1文字をAccessからHTMLで出力したときのコードポイントで返す
  Dim txt As String
  Dim rst As String, hRst As String, UCS4Str As String
  Dim u8rst As String
  Dim d As String
  txt = ActiveCell.Text
  
  Dim i As Long, c As String, b As String
  For i = 1 To Len(txt)
    c = Mid(txt, i, 1)
    rst = rst & "&#" & IIf(AscW(c) < 0, AscW(c) + 65536, AscW(c)) & ";"
    rst = rst & "&#x" & Hex(IIf(AscW(c) < 0, AscW(c) + 65536, AscW(c))) & ";"
    UCS4Str = UCS4Str & """" & Hex(AscW(c)) & """" & ","
  Next
  Debug.Print rst 'Access用のHTMLコード
  Debug.Print hRst ' UTF-16LE の16進コードポイント ただし通常のHTMLでは使用できない
  Debug.Print UCS4Str ’ UCS4Stringに入れるための配列用
Exit Sub
' ここからは失敗しているので、この上で終了
  For i = 1 To Len(txt) Step 2
' 何かの除外条件で、そのまま文字とするか、iを変化させるの操作を行わないと文字化けを起こす
' 残念ながら現時点では不明
    c = Mid(txt, i, 2)
    d = MidB(txt, i, 2)
    If (MidB(txt, i, 2) = Mid(txt, i, 1)) And (Hex(AscW(c)) <> &H200D) Then
    Debug.Print AscW(Mid(txt, i, 1)) = WorksheetFunction.Unicode(MidB(txt, i, 2))
    Debug.Print AscW(c)
    Debug.Print Asc(c)
    u8rst = u8rst & CStr(d)
    i = i - 1
    Else
    u8rst = u8rst & CStr("&#x" & Hex(WorksheetFunction.Unicode(c))) & ";"
    End If
    'Debug.Print i, WorksheetFunction.Unicode(c)
  Next
  Debug.Print u8rst
End Sub


しかし
https://qiita.com/Q11Q/items/670ca6c127a2ddce122d
こちらのコードももっと簡単になりそうな見通しは立った。

# コード
## ベータバージョン
Activecellに1文字だけ入っているとしてイミディエイトウィンドウに表示する
emoji sarrogate ivsには対応していると思われる。

```vb
Sub DecodeUTF_8Hex_Beta()
Dim i As Long
Dim iMax As Long
Dim blIVS As Boolean
Dim blzwj As Boolean
Dim blSarrogate As Boolean
Dim chkzwj
blSarrogate = False: blzwj = False: blIVS = False: blzwj = False
If Len(ActiveCell.Value) > 1 Then
If Len(Mid(ActiveCell.Value, 1, Len(ActiveCell.Value))) = 3 Then
blIVS = True: iMax = 3
ElseIf Len(ActiveCell.Value) > 4 Then
blzwj = True
iMax = Len(ActiveCell.Value)
ElseIf WorksheetFunction.Unicode(ActiveCell.Value) > &H10000 And (Len(ActiveCell.Value) * 2 = LenB(ActiveCell.Value) And (Len(ActiveCell.Value) Mod 2 = 0)) Then
blSarrogate = True
iMax = 2
ElseIf WorksheetFunction.Unicode(ActiveCell.Value) <= &H10000 And (Len(ActiveCell.Value) * 2 = LenB(ActiveCell.Value) And (Len(ActiveCell.Value) Mod 2 <> 0)) Then
blzwj = True
iMax = Len(ActiveCell.Value)
ElseIf Len(ActiveCell.Value) < LenB(ActiveCell.Value) Then
iMax = LenB(ActiveCell.Value)
End If
For i = 1 To iMax Step 2
  If blSarrogate = True Then Debug.Print Hex(WorksheetFunction.Unicode(ActiveCell.Value)): Exit For

  If blIVS = True Then
    Debug.Print i, Hex(WorksheetFunction.Unicode(MidB(ActiveCell.Value, i, 2)))
    Debug.Print 3, Hex(WorksheetFunction.Unicode(MidB(ActiveCell.Value, 3)))
    Exit For
  End If
  If blzwj Then
    Debug.Print i, Hex(WorksheetFunction.Unicode(Mid(ActiveCell.Value, i, 2)))
  Else
    Debug.Print i, Hex(WorksheetFunction.Unicode(MidB(ActiveCell.Value, i, 1)))
  End If
 Next
Else
'Len(ActiveCell.Value) = 1
Debug.Print Hex(WorksheetFunction.Unicode(ActiveCell.Value))
End If
End Sub

まとめ

以上の1文字だけならUTF-8のコードポイントにエンコードできた。ワークシート関数を使うことでとても簡単になった。
しかし、文字が連続すると、単純に変換できなくなる。何らかの除外条件が必要だが、今回はここが不明点として残った。
AscWができたことでUTF-16LEのコードポイントへエンコードするのはもっとコードが簡単になることがわかった。
文字数のカウントは問題だが、少なくともエンコードとデコードはUTF-16LEの方が有利だという印象はますます強くなった。