更新日:、 作成日:

VBA 文字コードを変換や判定、文字化けを解消する

はじめに

Excel VBA 文字コードを変換や判定、文字化けを解消する方法を紹介します。

VBA の文字コードは Unicode (UTF-16) です。ただし Shift_JIS に存在しない文字 などを入力すると ? に文字化けします。

StrConv 関数」から、Unicode (UTF-16) を Shift_JIS に変換できます。逆に変換もできます。

ChrW 関数」から、Unicode 文字やサロゲートペア文字 𩸽😃 などを入力できます。

Asc 関数」から、Shift_JIS の文字か、Unicode のサロゲートペア文字か判定できます。

Unicode (UTF-8, UTF-16) のファイルを読み込めるかどうかは、何を使って読み込むかによって変わります。

文字コードと文字化けについて

VBA の文字コードは Unicode (UTF-16) です。しかし、開発画面のコード上に入力や表示できる文字コードは Shift_JIS です。そのため、Shift_JIS に存在しない文字 などは、直接入力や表示はできません。? に文字化けします。

Excel は Unicode 文字を入力も表示もできます。VBA の変数に Unicode 文字を代入しても文字化けしません。あくまでコードに直接 Unicode 文字を入力したときだけ文字化けします。

Dim s As String
s = Range("A1").Value ' 頰
Range("B1").Value = s ' 頰

サロゲートペア文字は上位と下位の 2 文字として扱われます。

開発画面が文字化け

VBA の開発画面の日本語が文字化けするときは、Windows のシステムロケールが日本語になっていないかもしれません。

エクスプローラーを表示し、アドレスバーに intl.cpl を入力して Enter キーを入力します。

[管理] タブから [システムロケールの変更] をクリックします。

現在のシステムロケールに [日本語 (日本)] を選択し、[ワールドワイド言語サポートでの Unicode UTF-8 を使用] のチェックを外して [OK] をクリックします。

1

Windows を再起動すると文字化けが解消されているはずです。

文字コードを変換する

文字コードを UTF-16Shift_JIS に変換できます。それ以外の文字コードには変換できません。

Unicode (UTF-16) の文字はすべて 2 バイトです。

Dim i As Integer

i = LenB("ABC")
Debug.Print(i) ' 6, UTF-16

i = LenB("ABC")
Debug.Print(i) ' 6, UTF-16

StrConv 関数」を使用して、文字コードを Shift_JIS に変換できます。

Dim s As String
Dim i As Integer

s = StrConv("ABC", vbFromUnicode)    ' UTF-16 を Shift_JIS に変換
i = LenB(s)
Debug.Print(i) ' 3, Shift_JIS

s = StrConv("ABC", vbFromUnicode) ' UTF-16 を Shift_JIS に変換
i = LenB(s)
Debug.Print(i) ' 6, Shift_JIS

同じように「StrConv 関数」を使用して、文字コードを Shift_JIS に変換したものを Unicode (UTF-16) に戻せます。

Dim s As String
Dim i As Integer

s = StrConv("ABC", vbFromUnicode)    ' UTF-16 を Shift_JIS に変換
s = StrConv(s, vbUnicode)            ' Shift_JIS を UTF-16 に変換
i = LenB(s)
Debug.Print(i) ' 6, UTF-16

s = StrConv("ABC", vbFromUnicode) ' UTF-16 を Shift_JIS に変換
s = StrConv(s, vbUnicode)            ' Shift_JIS を UTF-16 に変換
i = LenB(s)
Debug.Print(i) ' 6, UTF-16

Unicode 文字を入力する

Shift_JIS に存在しない文字 などを入力すると ? に文字化けします。これは実際に ? を入力したのと同じです。サロゲートペア文字 𩸽😃 などを入力すると ?? に文字化けします。

Dim s As String
s = "?"  ' 頰
s = "??" ' 𩸽
s = "??" ' 😃

Unicode 文字を入力

Excel の「エクセル UNICHAR 関数:Unicode を文字に変換する」を使用して、Unicode 番号から文字を入力できます。

Excel の関数を使用するには「WorksheetFunction」をご覧ください。
Range("A1").Value = WorksheetFunction.Unichar(38960)   ' 頰
Range("A1").Value = WorksheetFunction.Unichar(&H9830)  ' 頰, エラー Integer になるため
Range("A1").Value = WorksheetFunction.Unichar(&H9830&) ' 頰, 末尾に & を付けて Long にする

Range("A2").Value = WorksheetFunction.Unichar(171581)  ' 𩸽
Range("A2").Value = WorksheetFunction.Unichar(&H29E3D) ' 𩸽

Range("A3").Value = WorksheetFunction.Unichar(128515)  ' 😃
Range("A3").Value = WorksheetFunction.Unichar(&H1F603) ' 😃
VBA で 16 進数を入力するには &H3042 のように &H を頭に付けます。

Unicode 番号を取得

Excel の「エクセル UNICODE 関数:文字の Unicode を取得する」を使用して、文字の Unicode 番号を取得できます。

Dim s As String
Dim d As Double

s = WorksheetFunction.Unichar(38960)' 頰
d = WorksheetFunction.Unicode(s)
Debug.Print(d)      ' 38960
Debug.Print(Hex(d)) ' 9830

s = WorksheetFunction.Unichar(171581)' 𩸽
d = WorksheetFunction.Unicode(s)
Debug.Print(d)      ' 171581
Debug.Print(Hex(d)) ' 29E3D

s = WorksheetFunction.Unichar(128515)' 😃
d = WorksheetFunction.Unicode(s)
Debug.Print(d)      ' 128515
Debug.Print(Hex(d)) ' 1F603

Hex 関数」を使用して、数値を 16 進数に変換できます。

その他の方法

VBA の「ChrW 関数」を使用しても Unicode の文字を入力できます。ただしサロゲートペア文字を入力するには上位と下位の文字を結合する必要があります。

Range("A1").Value = ChrW(-26576) ' 頰, Integer
Range("A1").Value = ChrW(38960)  ' 頰, Long
Range("A1").Value = ChrW(&H9830) ' 頰, 16 進数

Range("A2").Value = ChrW(-10137) & ChrW(-8643) ' 𩸽, Integer

サロゲートペア文字の上位と下位の Unicode を取得するには、「Mid 関数」でそれぞれの文字を抽出して「AscW 関数」で文字コードを取得します。サロゲートペア文字は 2 文字として扱われます。

Dim s As String
s = WorksheetFunction.Unichar(171581) ' 𩸽

Dim high As Integer ' 上位コード
Dim low As Integer  ' 下位コード
high = AscW(Mid(s, 1, 1))
low = AscW(Mid(s, 2, 1))
Debug.Print(high) ' -10137
Debug.Print(low)  ' -8643

Range("A1").Value = ChrW(high) & ChrW(low) ' 𩸽
AscW 関数」の戻り値が Integer なので負の値になるときがあります。これを常に正の値にするには CUInt 関数を作成して変換できます。詳しくは「AscW 関数」のページをご覧ください。

Shift_JIS 文字を判定する

Shift_JIS に存在する文字か判定するための関数を作成します。

IsShiftJIS 関数 に判定したい文字列を渡して、その最初の文字が Shift_JIS の文字か判定します。True なら Shift_JIS に存在する文字です。

IsShiftJISAll 関数 に判定したい文字列を渡して、そのすべての文字が Shift_JIS の文字か判定します。True なら Shift_JIS に存在する文字です。

Sub 実行()
    Dim s As String
    Dim b As Boolean

    s = "あ"
    b = IsShiftJIS(s)
    Debug.Print(b) ' True

    s = WorksheetFunction.Unichar(38960)  ' 頰
    b = IsShiftJIS(s)
    Debug.Print(b) ' False

    s = WorksheetFunction.Unichar(128515) ' 😃
    b = IsShiftJIS(s)
    Debug.Print(b) ' False

    s = "ABC"
    b = IsShiftJISAll(s)
    Debug.Print(b) ' True

    s = "ABC" & WorksheetFunction.Unichar(38960) ' 頰
    b = IsShiftJISAll(s)
    Debug.Print(b) ' False
End Sub

' 指定した文字列の最初の文字が Shift_JIS の文字かどうか
Function IsShiftJIS(ByVal text As String) As Boolean
    ' 空なら Shift_JIS
    If text = "" Then
        IsShiftJIS = True
        Exit Function
    End If

    Dim first As String  ' 最初の文字
    first = Left(text, 1)

    Dim qCode As Integer ' ? の文字コード
    qCode = Asc("?")

    ' 比較するときは、本来の文字と比較される
    ' Asc 関数は Shift_JIS に存在しない文字なら、文字化け後の ? のコードを取得する
    If (first <> "?") And (Asc(first) = qCode) Then
        ' Unicode など
        IsShiftJIS = False
        Exit Function
    End If

    ' Shift_JIS
    IsShiftJIS = True    
End Function

' 指定したすべての文字列が Shift_JIS の文字かどうか
Function IsShiftJISAll(ByVal text As String) As Boolean
    ' 空なら Shift_JIS
    If text = "" Then
        IsShiftJISAll = True
        Exit Function
    End If

    Dim length As Long ' 文字数
    length = Len(text)

    Dim char As String ' 列挙された 1 文字
    
    Dim i As Long
    For i = 1 To length
        char = Mid(text, i, 1)

        If IsShiftJIS(char) = False Then
            ' Unicode など
            IsShiftJISAll = False
            Exit Function
        End If
    Next

    ' Shift_JIS
    IsShiftJISAll = True    
End Function

サロゲートペア文字を判定する

サロゲートペア文字か判定するための関数を作成します。

IsSurrogate 関数 に判定したい文字列を渡して、その最初の文字がサロゲートペア文字か判定します。True ならサロゲートペア文字です。

IsHighSurrogate 関数 に「AscW 関数」で取得した文字コードを渡して、上位コードか判定します。

IsLowSurrogate 関数 に「AscW 関数」で取得した文字コードを渡して、下位コードか判定します。

Sub 実行()
    Dim s As String
    Dim b As Boolean

    s = WorksheetFunction.Unichar(38960)  ' 頰
    b = IsSurrogate(s)
    Debug.Print(b) ' False

    s = WorksheetFunction.Unichar(171581) ' 𩸽
    b = IsSurrogate(s)
    Debug.Print(b) ' True

    s = WorksheetFunction.Unichar(128515) ' 😃
    b = IsSurrogate(s)
    Debug.Print(b) ' True

    s = "あ"
    b = IsSurrogate(s)
    Debug.Print(b) ' False
End Sub

' 指定した文字列の最初の文字がサロゲートペア文字かどうか
Function IsSurrogate(ByVal text As String) As Boolean
    ' 1 文字ならサロゲートペアではない
    If Len(text) <= 1 Then
        IsSurrogate = False
        Exit Function
    End If

    ' 上位を取得
    Dim high As Integer
    high = AscW(Mid(text, 1, 1))

    Dim isHigh As Boolean
    isHigh = IsHighSurrogate(high)

    ' 下位を取得
    Dim low As Integer
    low = AscW(Mid(text, 2, 1))

    Dim isLow As Boolean
    isLow = IsLowSurrogate(low)

    ' サロゲートペア
    IsSurrogate = (isHigh And isLow)
End Function

' 指定した文字コードがサロゲートの上位コードかどうか
Function IsHighSurrogate(ByVal code As Integer) As Boolean

    If (&HD800 <= code And code <= &HDBFF) Then
        ' 上位
        IsHighSurrogate = True
    Else
        ' それ以外
        IsHighSurrogate = False
    End If

End Function

' 指定した文字コードがサロゲートの下位コードかどうか
Function IsLowSurrogate(ByVal code As Integer) As Boolean

    If (&HDC00 <= code And code <= &HDFFF) Then
        ' 下位
        IsLowSurrogate = True
    Else
        ' それ以外
        IsLowSurrogate = False
    End If

End Function

IsReverseSurrogate 関数 に「StrReverse 関数」で反転されている文字列を渡して、その最初の文字がサロゲートペア文字か判定します。True ならサロゲートペア文字です。

' 指定した反転された文字列の最初の文字がサロゲートペア文字かどうか
Function IsReverseSurrogate(ByVal text As String) As Boolean
    ' 1 文字はサロゲートペアではない
    If Len(text) <= 1 Then
        IsReverseSurrogate = False
        Exit Function
    End If

    ' 下位を取得
    Dim low As Integer
    low = AscW(Mid(text, 1, 1))

    Dim isLow As Boolean
    isLow = IsLowSurrogate(low)

    ' 上位を取得
    Dim high As Integer
    high = AscW(Mid(text, 2, 1))

    Dim isHigh As Boolean
    isHigh = IsHighSurrogate(high)

    ' サロゲートペア
    IsReverseSurrogate = (isLow And isHigh)
End Function

サロゲートペア文字を 1 文字として取得する

サロゲートペア文字が含まれた文字列を 1 文字ずつ取得するには次のようにします。サロゲートペア文字を 1 文字として扱えるようにしています。上記で作成した判定用の関数を使用しています。

Dim s As String ' 列挙する文字列
s = "あ" & WorksheetFunction.Unichar(38960) & WorksheetFunction.Unichar(171581) ' あ𩸽😃

Dim length As Integer
length = Len(s) ' 4、列挙する文字数

Dim char As String  ' 列挙された 1 文字
Dim high As Integer ' その上位コード

' 列挙する
Dim i As Integer
For i = 1 To length

    char = Mid(s, i, 1) ' 1 文字取得
    high = AscW(char)

    If IsSurrogate(Mid(s, i)) Then
        ' サロゲートペア文字
        char = Mid(s, i, 2) ' 2 文字取得
        i = i + 1

    ElseIf IsHighSurrogate(high) Then
        ' 上位だけで下位がない異常な文字

    ElseIf IsLowSurrogate(high) Then
        ' 下位だけで上位がない異常な文字

    Else
        ' Unicode を含む文字

    End If

    Range("A" & i).Value = char ' あ 𩸽 😃
Next

ファイルの読み書き

文字コードが Unicode (UTF-8, UTF-16) のファイルを読み込めるかどうかは、使用する関数やオブジェクトに依存します。詳しくはそのページをご覧ください。

  • Input 関数」:Shift_JIS のみ読み込めます。
  • FileSystemObject」:Shift_JIS と UTF-16 を読み込めます。
  • QueryTables」:Shift_JIS と UTF-8 を読み込めます。UTF-16 も良ければ読み込めます。
  • Workbooks」:Shift_JIS と UTF-8 を読み込めます。UTF-16 も良ければ読み込めます。

著者:Tipsfound