異体字を含む文字列の長さを VBA で調べる

GraphemeLength.bas

Option Explicit
'
' http://bbs.wankuma.com/   -  Thread No95539
'
Public Function LenExp(ByVal text As String) As Long
    Dim rawLen As Long, length As Long
    rawLen = Len(text)
    length = 0&
    Dim i As Long, uni As Long, pair As Long
    i = 0&
    Do While i < rawLen
        i = i + 1&
        uni = AscW(Mid(text, i, 1&))
        If uni < 0 Then uni = uni + &H10000

        If &HFE00& <= uni And uni <= &HFE0F& Then
            '字形選択子 VS1～VS16 の場合は、文字数にカウントしない
        ElseIf uni <= &HD7FF& Or &HE000& <= uni Then
            'サロゲートペアでない文字は、たとえ非可読文字であっても一文字としてカウント
            length = length + 1&
        ElseIf &HDC00& <= uni And uni <= &HDFFF& Then
            '先頭から辿っているのに、上位サロゲート無しで下位サロゲートが現れるのは異常
            Err.Raise vbObjectError + 1&, , "下位サロゲートが単独検出されました。"
        Else
            '上位サロゲートが検出された場合は、ペアとなる下位サロゲートの存在を確認する
            i = i + 1&
            If rawLen < i Then
                '文字列の末尾が上位サロゲートだった
                Err.Raise vbObjectError + 2&, , "下位サロゲートが存在しません。"
            Else
                pair = AscW(Mid(text, i, 1&)) + &H10000
                If pair < &HDC00& Or &HDFFF& < pair Then
                    'サロゲートが正しい組み合わせになっていない場合は異常
                    Err.Raise vbObjectError + 3&, , "不正なサロゲートペアです。"
                End If
            End If
            If uni <> &HDB40& Then
                '正しいサロゲートペアだと確認できたので、一文字としてカウント
                'ただし 字形選択子 VS17～VS256 だった場合は、文字数にカウントしない
                length = length + 1&
            End If
        End If
    Loop
    LenExp = length
End Function

GraphemeLength_Test.bas

Option Explicit

Public Sub Example()
'
'『ホッケ』は、サロゲートペアの例として良く挙げられる文字。
'異体字セレクタも併用した場合、UTF-16 だと 1 文字が 8 バイトになる。
'
    '【U+29E3D】
    'U+4ECA … CJK互換文字[29E3D]
    Range("A1").Value = ChrW(&HD867) & ChrW(&HDE3D)
    'U+29E3D_E0100 … Adobe-Japan1[CID+20315]
    Range("A2").Value = ChrW(&HD867) & ChrW(&HDE3D) & ChrW(&HDB40) & ChrW(&HDD00)
    'U+29E3D_E0101 … Adobe-Japan1[CID+15437]
    Range("A3").Value = ChrW(&HD867) & ChrW(&HDE3D) & ChrW(&HDB40) & ChrW(&HDD01)
    'U+29E3D_E0102 … Hanyo-Denshi[JD9344]、Moji_Joho[MJ055217]
    Range("A4").Value = ChrW(&HD867) & ChrW(&HDE3D) & ChrW(&HDB40) & ChrW(&HDD02)
    'U+29E3D_E0103 … Hanyo-Denshi[KS523690]、Moji_Joho[MJ055216]
    Range("A5").Value = ChrW(&HD867) & ChrW(&HDE3D) & ChrW(&HDB40) & ChrW(&HDD03)
    'U+29E3D_E0104 … Moji_Joho[MJ055218]
    Range("A6").Value = ChrW(&HD867) & ChrW(&HDE3D) & ChrW(&HDB40) & ChrW(&HDD04)

'
'『今』は統合漢字であるが(4ECA)、その俗字の「テ今」が、同じく統合漢字として 2B746 に収録されている。
'Adobe-Japan1 コレクションの場合、「ラ今」の U+4ECA に 字形選択子 VS17 を付与して表現することもある。
'
    '【U+4ECA】
    'U+4ECA … CJK統合漢字[4ECA]
    Range("B1").Value = ChrW(&H4ECA)
    'U+4ECA_E0100 … Adobe-Japan1[CID+2067]　「ラ今」  // 基底文字 + VS17
    Range("B2").Value = ChrW(&H4ECA) & ChrW(&HDB40) & ChrW(&HDD00)
    'U+4ECA_E0101 … Adobe-Japan1[CID+13780]　「テ今」  // 基底文字 + VS18
    Range("B3").Value = ChrW(&H4ECA) & ChrW(&HDB40) & ChrW(&HDD01)
  
    '【U+2B746】
    'U+2B746 … CJK統合文字[2B746]
    Range("C1").Value = ChrW(&HD86D) & ChrW(&HDF46)
    'U+2B746_E0100 … Adobe-Japan1[CID+13780]　「テ今」  // 基底文字 + VS17
    Range("C2").Value = ChrW(&HD86D) & ChrW(&HDF46) & ChrW(&HDB40) & ChrW(&HDD00)
    'U+2B746_E0101 … Hanyo-Denshi[IB0610S]、Moji_Joho[MJ059309]  // 基底文字 + VS18
    Range("C3").Value = ChrW(&HD86D) & ChrW(&HDF46) & ChrW(&HDB40) & ChrW(&HDD01)
    'U+2B746_E0102 … Hanyo-Denshi[JTADCBS]、Moji_Joho[MJ059340]  // 基底文字 + VS19
    Range("C4").Value = ChrW(&HD86D) & ChrW(&HDF46) & ChrW(&HDB40) & ChrW(&HDD02)
    'U+2B746_E0103 … Hanyo-Denshi[KS004890S]、Moji_Joho[MJ056904]  // 基底文字 + VS20
    Range("C5").Value = ChrW(&HD86D) & ChrW(&HDF46) & ChrW(&HDB40) & ChrW(&HDD03)
    'U+2B746_E0104 … Hanyo-Denshi[TK01002330]  // 基底文字 + VS21
    Range("C6").Value = ChrW(&HD86D) & ChrW(&HDF46) & ChrW(&HDB40) & ChrW(&HDD04)

'
'『花』には、統合漢字(82B1)と互換漢字(2F993)が存在するが、"IPAmj明朝" は 2F993 に対応していない。
'Unicode 正規化の影響を避けるため、互換漢字を「統合漢字 + VS」で表現することがあるが、
'その場合、U+82B1,U+FE00 で表現されることになる。
'この場合の字形選択子 は IVS ではなく SVS であることに注意。
'
    '【U+2F993】
    'U+2F993 … CJK互換文字[2F993]
    Range("D1").Value = ChrW(&HD87E) & ChrW(&HDD93)
  
    '【U+82B1】
    'U+82B1 … CJK統合漢字[82B1]
    Range("E1").Value = ChrW(&H82B1)
    'U+82B1_FE00 … CJK互換文字[2F993]　// 統合漢字 + VS1
    Range("E2").Value = ChrW(&H82B1) & ChrW(&HFE00)
    'U+82B1_E0100 … Adobe-Japan1[CID+1366]  // 基底文字 + VS17
    Range("E3").Value = ChrW(&H82B1) & ChrW(&HDB40) & ChrW(&HDD00)
    'U+82B1_E0101 … Adobe-Japan1[CID+13666]  // 基底文字 + VS18
    Range("E4").Value = ChrW(&H82B1) & ChrW(&HDB40) & ChrW(&HDD01)
    'U+82B1_E0102 … Hanyo-Denshi[JA1854]、Moji_Joho[MJ021591]  // 基底文字 + VS19
    Range("E5").Value = ChrW(&H82B1) & ChrW(&HDB40) & ChrW(&HDD02)
    'U+82B1_E0103 … Hanyo-Denshi[JTB937S]、Moji_Joho[MJ021592]  // 基底文字 + VS20
    Range("E6").Value = ChrW(&H82B1) & ChrW(&HDB40) & ChrW(&HDD03)
    'U+82B1_E0104 … Hanyo-Denshi[JTB933]、Moji_Joho[MJ021593]  // 基底文字 + VS21
    Range("E7").Value = ChrW(&H82B1) & ChrW(&HDB40) & ChrW(&HDD04)
    'U+82B1_E0105 … Hanyo-Denshi[TK01011530]  // 基底文字 + VS22
    Range("E8").Value = ChrW(&H82B1) & ChrW(&HDB40) & ChrW(&HDD05)
    'U+82B1_E0106 … Moji_Joho[MJ021594]  // 基底文字 + VS23
    Range("E9").Value = ChrW(&H82B1) & ChrW(&HDB40) & ChrW(&HDD06)

'
'『令』には、統合漢字(4EE4)と互換漢字(F9A8)が存在するが、"IPAmj明朝" は互換漢字の「令」には対応していない。
' Win10 版の "Malgun Gothic" であれば、F9A8 と 4EE4 の両方に対応しているが、このフォントは異体字セレクタ非対応。
'
    '【U+F9A8】
    'U+F9A8 … CJK互換文字[FA98]
    Range("F1").Value = ChrW(&HF9A8)

    '【U+4EE4】
    'U+4EE4 … CJK統合漢字[4EE4]
    Range("G1").Value = ChrW(&H4EE4)
    'U+4EE4_FE00 … CJK互換漢字[F9A8]  // 統合漢字 + VS1
    Range("G2").Value = ChrW(&H4EE4) & ChrW(&HFE00)
    'U+4EE41_E0100 … Adobe-Japan1[CID+4009]  // 基底文字 + VS17
    Range("G3").Value = ChrW(&H4EE4) & ChrW(&HDB40) & ChrW(&HDD00)
    'U+4EE41_E0101 … Hanyo-Denshi[JA4665]、Moji_Joho[MJ006533]  // 基底文字 + VS18
    Range("G4").Value = ChrW(&H4EE4) & ChrW(&HDB40) & ChrW(&HDD01)
    'U+4EE41_E0102 … Hanyo-Denshi[KS004910]、Moji_Joho[MJ056905]  // 基底文字 + VS19
    Range("G5").Value = ChrW(&H4EE4) & ChrW(&HDB40) & ChrW(&HDD02)

'
'『弁』の異体字は、Moji_Joho コレクションに収録されていないので、
' "IPAmj明朝" だと正しく表示されない。"花園明朝A" なら表示される。
'
    '【U+5F01】
    'U+5F01 … CJK統合漢字[5F01]
    Range("H1").Value = ChrW(&H5F01)
    'U+5F01_E0100 … Adobe-Japan1[CID+3627]  // 基底文字 + VS17
    Range("H2").Value = ChrW(&H5F01) & ChrW(&HDB40) & ChrW(&HDD00)
    'U+5F01_E0101 … Hanyo-Denshi[JA4259]  // 基底文字 + VS18
    Range("H3").Value = ChrW(&H5F01) & ChrW(&HDB40) & ChrW(&HDD01)
    'U+5F01_E0102 … Hanyo-Denshi[TK01028970]  // 基底文字 + VS19
    Range("H4").Value = ChrW(&H5F01) & ChrW(&HDB40) & ChrW(&HDD02)
    'U+5F01_E0103 … Hanyo-Denshi[TK01028980S]  // 基底文字 + VS20
    Range("H5").Value = ChrW(&H5F01) & ChrW(&HDB40) & ChrW(&HDD03)
End Sub