VBAの勉強を始めてみた

色々試しています。

Option Compare Text でマッチする文字列を全部調べてみた(Tips-15)

今回は以下の記事の続きです。 

kouten0430.hatenablog.com

Option Compare Textを宣言して文字列比較を行った場合、文字コードが同じもの以外にどんな文字列が類縁の文字としてマッチするのか・・・・・・。前回は比較サンプルが少なく不十分だったので、今回は文字コード0000~FFFFの全組み合わせを漏れなく調べてみました。
方法は、エクセルシートの1行目と1列目に文字列を配置し、行と列の全組み合わせを比較します(文字コードが制御文字や不使用領域であっても無関係に比較します)。比較の結果がTrueであれば、行と列が交差する位置に○をつけるという寸法です。

コードは後述しますが、文字列の生成~文字列の比較~シートへの結果出力まで、すべてVBAで行います。

f:id:kouten0430:20190112154144p:plain

基本的には、このように右下がりに○が付きますが、表示を縮小していくと○の重複箇所が見えてきます。

f:id:kouten0430:20190112154243p:plain

何がマッチして、何がマッチしないのか・・・・・・。○をフィルタリングすることで確認することが可能になります。4294967296通りの組み合わせを掲載することはできないので、記事内ではいくつか抜粋して紹介することにします。

 

半角の 1

f:id:kouten0430:20190112154654p:plain

半角、上付き、下付き、丸数字、全角にマッチします。

丸数字の違いがわかりづらいのでちょっと拡大してみます。

f:id:kouten0430:20190112154722p:plain

よく見ると二重丸だったり、文字の太さが違ったりしていますね。

 

半角の A

f:id:kouten0430:20190112154826p:plain

半角大文字、半角小文字、下付きの大文字、上付きの大文字、上付きの小文字、下付きの小文字、全角大文字、全角小文字にマッチします。

 

平仮名の あ

f:id:kouten0430:20190112154914p:plain

平仮名、全角片仮名、半角片仮名にマッチします。

 

平仮名の ゑ

f:id:kouten0430:20190112155031p:plain

平仮名、全角片仮名にマッチします。同じ読みの「え」や「エ」にはマッチしません。

 

ローマ数字の Ⅳ

f:id:kouten0430:20190112155110p:plain

ローマ数字の大文字と小文字にマッチします。

 

ギリシャ文字の α

f:id:kouten0430:20190112155215p:plain

ギリシャ文字の大文字と小文字にマッチします。見た目は似ているけどアルファベットのAにはマッチしません(半角の Aで、915行目がマッチしていないことからも分かります)。

 

特殊文字

f:id:kouten0430:20190112155423p:plain

f:id:kouten0430:20190112155437p:plain

同じ文字コードの文字のみマッチします。(電話は白と黒で別物扱いだし、ゆきだるまは他にも数種類あるけれどマッチしていません)

 

漢字

f:id:kouten0430:20190112155546p:plain

f:id:kouten0430:20190112155558p:plain

同じ文字コードと同じ意味(?)の韓国文字がマッチする。これからは덟렗と名乗ることにします(嘘)

 

さて・・・・・・。

こんなことをしても何の得にもならないので、試してみようという酔狂な人はいないと思いますが、コードを掲載しておきます(使い捨てなので雑ですけど)。エクセルシートの列数が足りないので、全部調べる場合は5シートに分けて5つのプロシージャを実行する必要があります。まっさらなシートをアクティブにした状態でプロシージャを実行すると、文字列の生成→文字列の比較→シートへの結果出力までを自動で行います。(結果を見やすくするための罫線の描画やオートフィルターの適用はプログラムに含まれていません)

 

文字コード0000~3FFEまでと0000~FFFFの比較

Option Compare Text
Sub 文字コード3FFEまで()
    Dim 行配列(2 To 65537) As String
    Dim 列配列(2 To 16384) As String
    
    行 = 2
    列 = 2
    
    Application.ScreenUpdating = False
    
    For Unicode = &H0 To &H7FFF
        If Unicode < &H3FFF Then
            行配列(行) = ChrW(Unicode)
            列配列(列) = ChrW(Unicode)
            行 = 行 + 1
            列 = 列 + 1
        Else
            行配列(行) = ChrW(Unicode)
            行 = 行 + 1
        End If
    Next Unicode
    
    For Unicode = &H8000 To &HFFFF  'ここからマイナス符号付き
        行配列(行) = ChrW(Unicode)
        行 = 行 + 1
    Next Unicode
    
    Range(Cells(1, 2), Cells(1, 16384)).Value = 列配列
    Range(Cells(2, 1), Cells(65537, 1)).Value = WorksheetFunction.Transpose(行配列)
    
    For 行 = 2 To 65537
        For 列 = 2 To 16384
            If 行配列(行) <> "" And 列配列(列) <> "" Then
                If 行配列(行) = 列配列(列) Then
                    Cells(行, 列).Value = "○"
                End If
            End If
        Next 列

        Application.StatusBar = "比較中..." & 行 & "/" & "65537行"
        DoEvents
    Next 行

    Application.StatusBar = False

End Sub

 

 文字コード3FFF~7FFDまでと0000~FFFFの比較

Option Compare Text
Sub 文字コード7FFDまで()
    Dim 行配列(2 To 65537) As String
    Dim 列配列(2 To 16384) As String
    
    行 = 2
    列 = 2
    
    Application.ScreenUpdating = False
    
    For Unicode = &H0 To &H7FFF
        If Unicode >= &H3FFF And Unicode < &H7FFE Then
            行配列(行) = ChrW(Unicode)
            列配列(列) = ChrW(Unicode)
            行 = 行 + 1
            列 = 列 + 1
        Else
            行配列(行) = ChrW(Unicode)
            行 = 行 + 1
        End If
    Next Unicode
    
    For Unicode = &H8000 To &HFFFF  'ここからマイナス符号付き
        行配列(行) = ChrW(Unicode)
        行 = 行 + 1
    Next Unicode
    
    Range(Cells(1, 2), Cells(1, 16384)).Value = 列配列
    Range(Cells(2, 1), Cells(65537, 1)).Value = WorksheetFunction.Transpose(行配列)
    
    For 行 = 2 To 65537
        For 列 = 2 To 16384
            If 行配列(行) <> "" And 列配列(列) <> "" Then
                If 行配列(行) = 列配列(列) Then
                    Cells(行, 列).Value = "○"
                End If
            End If
        Next 列

        Application.StatusBar = "比較中..." & 行 & "/" & "65537行"
        DoEvents
    Next 行

    Application.StatusBar = False

End Sub

 

 文字コード7FFE~BFFCまでと0000~FFFFの比較

Option Compare Text
Sub 文字コードBFFCまで()
    Dim 行配列(2 To 65537) As String
    Dim 列配列(2 To 16384) As String
    
    行 = 2
    列 = 2
    
    Application.ScreenUpdating = False
    
    For Unicode = &H0 To &H7FFF
        If Unicode >= &H7FFE And Unicode <= &H7FFF Then
            行配列(行) = ChrW(Unicode)
            列配列(列) = ChrW(Unicode)
            行 = 行 + 1
            列 = 列 + 1
        Else
            行配列(行) = ChrW(Unicode)
            行 = 行 + 1
        End If
    Next Unicode
    
    For Unicode = &H8000 To &HFFFF  'ここからマイナス符号付き
        If Unicode >= &H8000 And Unicode < &HBFFD Then
            行配列(行) = ChrW(Unicode)
            列配列(列) = ChrW(Unicode)
            行 = 行 + 1
            列 = 列 + 1
        Else
            行配列(行) = ChrW(Unicode)
            行 = 行 + 1
        End If
    Next Unicode
    
    Range(Cells(1, 2), Cells(1, 16384)).Value = 列配列
    Range(Cells(2, 1), Cells(65537, 1)).Value = WorksheetFunction.Transpose(行配列)
    
    For 行 = 2 To 65537
        For 列 = 2 To 16384
            If 行配列(行) <> "" And 列配列(列) <> "" Then
                If 行配列(行) = 列配列(列) Then
                    Cells(行, 列).Value = "○"
                End If
            End If
        Next 列

        Application.StatusBar = "比較中..." & 行 & "/" & "65537行"
        DoEvents
    Next 行

    Application.StatusBar = False

End Sub

 

 文字コードBFFD~FFFBまでと0000~FFFFの比較

Option Compare Text
Sub 文字コードFFFBまで()
    Dim 行配列(2 To 65537) As String
    Dim 列配列(2 To 16384) As String
    
    行 = 2
    列 = 2
    
    Application.ScreenUpdating = False
    
    For Unicode = &H0 To &H7FFF
        行配列(行) = ChrW(Unicode)
        行 = 行 + 1
    Next Unicode
    
    For Unicode = &H8000 To &HFFFF  'ここからマイナス符号付き
        If Unicode >= &HBFFD And Unicode < &HFFFC Then
            行配列(行) = ChrW(Unicode)
            列配列(列) = ChrW(Unicode)
            行 = 行 + 1
            列 = 列 + 1
        Else
            行配列(行) = ChrW(Unicode)
            行 = 行 + 1
        End If
    Next Unicode
    
    Range(Cells(1, 2), Cells(1, 16384)).Value = 列配列
    Range(Cells(2, 1), Cells(65537, 1)).Value = WorksheetFunction.Transpose(行配列)
    
    For 行 = 2 To 65537
        For 列 = 2 To 16384
            If 行配列(行) <> "" And 列配列(列) <> "" Then
                If 行配列(行) = 列配列(列) Then
                    Cells(行, 列).Value = "○"
                End If
            End If
        Next 列

        Application.StatusBar = "比較中..." & 行 & "/" & "65537行"
        DoEvents
    Next 行

    Application.StatusBar = False

End Sub

 

文字コードFFFB~FFFFまでと0000~FFFFの比較

Option Compare Text
Sub 文字コードFFFFまで()
    Dim 行配列(2 To 65537) As String
    Dim 列配列(2 To 16384) As String
    
    行 = 2
    列 = 2
    
    Application.ScreenUpdating = False
    
    For Unicode = &H0 To &H7FFF
        行配列(行) = ChrW(Unicode)
        行 = 行 + 1
    Next Unicode
    
    For Unicode = &H8000 To &HFFFF  'ここからマイナス符号付き
        If Unicode >= &HFFFC And Unicode <= &HFFFF Then
            行配列(行) = ChrW(Unicode)
            列配列(列) = ChrW(Unicode)
            行 = 行 + 1
            列 = 列 + 1
        Else
            行配列(行) = ChrW(Unicode)
            行 = 行 + 1
        End If
    Next Unicode
    
    Range(Cells(1, 2), Cells(1, 16384)).Value = 列配列
    Range(Cells(2, 1), Cells(65537, 1)).Value = WorksheetFunction.Transpose(行配列)
    
    For 行 = 2 To 65537
        For 列 = 2 To 16384
            If 行配列(行) <> "" And 列配列(列) <> "" Then
                If 行配列(行) = 列配列(列) Then
                    Cells(行, 列).Value = "○"
                End If
            End If
        Next 列

        Application.StatusBar = "比較中..." & 行 & "/" & "65537行"
        DoEvents
    Next 行

    Application.StatusBar = False

End Sub

 

 注:私のPCでは1プロシージャ20分程度かかります。