VBA

black

明けましておめでとうございます。black です。

今回は業務に使うツール作成をしてみました。このツールは複数行にリスト化された文字列に対して、各行ごとに含まれる文字種を判定するものです。
テキストデータに意図しない文字種のデータが含まれていないかを確認したい場合があり、業務効率化と勉強がてらに作ってみました。

目次

  1. ツール作り
  2. 使い方
  3. ソース全文

ツール作り

ツールはインターフェイスの作成が不要な EXCEL の VBA で作ることにします。

まずはざっくりと仕様を以下のように決めました。

  • 1 列目のセルを、1 行目から入力行数分まで処理する
  • 入力文字を「全角文字」「半角英数」「全角半角の混在」の種別ごとにおおまかに分ける
  • 全角ひらがな、全角カタカナ、半角文字、半角カナ、半角記号に分類して抽出する
  • 各列の説明を一行目に挿入する (既に説明行がある場合はスキップ)

*完成イメージ

lab_img2

まずは半角か全角か混合かの判定を作成します。

'ANSI文字列に変換した文字列を取得
  set_text_ansi = StrConv(set_text, vbFromUnicode)
  
  If Len(set_text) = LenB(set_text_ansi) Then  '半角のみ
      ~
  ElseIf Len(set_text) * 2 = LenB(set_text_ansi) Then  '全角のみ
      ~
  Else  '半角と全角の混合

ここは文字数とバイト数で比較判定する定番の手法を採用しました。

まずは入力文字が半角である場合を作成。

For l_int_1 = 1 To Len(set_text)
    my_temp = Mid(set_text, l_int_1, 1)
    If my_temp Like "[a-z]" Or my_temp Like "[A-Z]" Then
        han_temp = han_temp & my_temp
    ElseIf my_temp Like "[。-゚]" Then '半角カナの場合
        kana_temp = kana_temp & my_temp
    Else 'アルファベット以外
        kigo_temp = kigo_temp & my_temp
    End If
Next

入力文字を一文字ずつ抽出しLike演算子で判定、
英字、半角カナであればそれぞれの専用の変数に格納、
それ以外は半角記号と見なすようにしました。
注意点は、半角カナのLike演算子の範囲を[ア-ン]にしてしまうと、
濁点半濁点が無視されてしまうので、そこまで含んだ指定にするところでしょうか。

しかしここで数字を失念していたことが発覚。

ElseIf my_temp Like "#" Then
    ~

なのでLIKE演算子で0~9の場合の条件分岐を追加しました。
さらに数字のみの場合や、日付の場合にも処理も分けた方がよさそうだと思い分岐を追加。

If VarType(set_text) = 8 Then '項目が文字型の時
    ~
ElseIf VarType(set_text) = 7 Then '項目が日付型の時
    ~
Else '項目がそれ以外の型の時(数字とみなす)
    If InStr(set_text, ".") Then '小数を含む数字の場合
        result = "数字(小数)"
        Cells(i, int_cell).Value = "<ALL(小数)>"
    Else
        result = "数字"
        Cells(i, int_cell).Value = "<ALL>"
    End If
End If

ここではVarType関数を使いました。戻り値で変数の型などを返してくれるので、文字、日付、数字などを大別するには便利です。

半角の対応は以上です。

次は全角の場合の対応です。

If set_text = StrConv(set_text, vbHiragana) Then '全てひらがな
    ~
ElseIf set_text = StrConv(set_text, bvkatakana) Then '全てカタカナ
    ~
Else '全角混合

各入力値を、元の値と、ひらがな変換したものと比較して一致していればひらがなと判定、
カタカナも同様に、という手段を取ろうと思いましたが、これには落とし穴が。。。
テストしてみると、全角の記号や長音が含まれていた時それを識別できないことが判明。
結局はここもLIKE演算子で対応することに。

'検証文字をばらす
For l_int_1 = 1 To Len(set_text)
        my_temp = Mid(set_text, l_int_1, 1)
    If my_temp Like "[あ-ん]" Then '五十音ひらがな
        hira_temp = hira_temp & my_temp
    ElseIf my_temp Like "[ア-ン]" Then  '五十音カタカナ
        zenkana_temp = zenkana_temp & my_temp
    ElseIf my_temp Like "ー" Then '長音対応
        hira_temp = hira_temp & my_temp
        zenkana_temp = zenkana_temp & my_temp
    Else 'それ以外(全角記号など)
        str_temp = my_temp
    End If
Next

やることは半角の時と同様ですが、長音のみはひらがなとカタカナどちらにも属するようにしています。

これで全角の場合も完成です。

全角と半角が混合している場合は上記を組み合わせて対応。
さて、これで基礎は完成しました。

次は空白文字の対応です。
ここまでの対応で、全角、半角それぞれの空白文字も記号として振り分けはされるのですが、
ぱっと見た目には分かりません。
そこで、空白文字判定用のカラムを追加し、空白文字あれば”○”が入るように対応。

あとは結果表示の調整です。
分類したデータが続き文字でない場合に、わかりやすいように間にカンマを挟むモジュールを追加します。

Function add_comma(temp As Variant) As Variant
    If temp <> "" And Right(temp, 1) <> "," Then
        temp = temp & ","
    End If
    add_comma = temp
End Function

これを文字判定の都度実行させます。

それと、一行目に各列の説明を挿入するコードも入れておきます。

    '各列の説明行の追加
    chk_str_header = "検証文字列"
    If Cells(1, 1) <> chk_str_header Then
        Application.CutCopyMode = False
        Range("1:1").Insert
        With Cells(1, 1)
            .Value = chk_str_header
            .Interior.Color = RGB(255, 255, 0)
        End With
        With Cells(1, hantei_cell)
            .Value = "型判定"
            .Interior.Color = RGB(0, 255, 255)
        End With
        Cells(1, zenkaku_cell).Value = "他全角"
        Cells(1, zenhira_cell).Value = "ひらがな"
        Cells(1, zenkana_cell).Value = "全角カナ"
        Cells(1, hankaku_cell).Value = "半角文字"
        Cells(1, hankana_cell).Value = "半角カナ"
        Cells(1, kigo_cell).Value = "半角記号"
        Cells(1, int_cell).Value = "数字"
        Cells(1, space_cell).Value = "全角空白"
        With Range("A1:J1")
            .Font.Bold = True
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
        End With
    End If

これで完成です。

使い方

Excel を開き、一番左の列に判別させたい文字列を入力します。

lab_img3

Visual Basic Editor に以下の ソース全文 を貼り付けて実行します。

実行した結果は以下のようになります。

lab_img1

カンマが含まれていた場合に見づらかったり、VBAなので処理速度がお察しの通りだったりと、
まだまだ問題もありますが、とりあえずは要求を満たすものができました。

専門職ではないので作りの甘い部分はありますが、
同じようなものが欲しい人の参考になればと思います。

ソース全文

Sub text_judge()
    Dim chk_str_header, my_temp, str_temp, hira_temp, zenkana_temp, num_temp, han_temp, kana_temp, kigo_temp As String
    Dim i, max_row, zenkaku_cell, zenhira_cell, zenkana_cell, hankaku_cell, hankana_cell, kigo_cell, int_cell, space_cell As Integer
    hantei_cell = 2     '型判定結果のcolumn位置
    zenkaku_cell = 3    '全角文字のcolumn位置
    zenhira_cell = 4    '全角ひらがなのcolumn位置
    zenkana_cell = 5    '全角カタカナのcolumn位置
    hankaku_cell = 6    '半角文字のcolumn位置
    hankana_cell = 7    '半角カナのcolumn位置
    kigo_cell = 8       '半角記号のcolumn位置
    int_cell = 9        '数字のcolumn位置
    space_cell = 10     '全角空白のcolumn位置
    
    '各列の説明行の追加
    chk_str_header = "検証文字列"
    If Cells(1, 1) <> chk_str_header Then
        Application.CutCopyMode = False
        Range("1:1").Insert
        With Cells(1, 1)
            .Value = chk_str_header
            .Interior.Color = RGB(255, 255, 0)
        End With
        With Cells(1, hantei_cell)
            .Value = "型判定"
            .Interior.Color = RGB(0, 255, 255)
        End With
        Cells(1, zenkaku_cell).Value = "他全角"
        Cells(1, zenhira_cell).Value = "ひらがな"
        Cells(1, zenkana_cell).Value = "全角カナ"
        Cells(1, hankaku_cell).Value = "半角文字"
        Cells(1, hankana_cell).Value = "半角カナ"
        Cells(1, kigo_cell).Value = "半角記号"
        Cells(1, int_cell).Value = "数字"
        Cells(1, space_cell).Value = "全角空白"
        With Range("A1:J1")
            .Font.Bold = True
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
        End With
    End If
    
    max_row = ActiveSheet.UsedRange.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    i = 2
    
    For i = 2 To max_row   'A列の最後まで繰り返し
        set_text = Cells(i, 1)
         
        '値がない場合はスキップ
        If Len(set_text) = 0 Then
            GoTo Continue
        End If
         
        'ANSI文字列に変換した文字列を取得
        set_text_ansi = StrConv(set_text, vbFromUnicode)
        
        'まず全角のみ、半角のみか判定
        
        If Len(set_text) = LenB(set_text_ansi) Then
        '半角だけの時
            If VarType(set_text) = 8 Then
                result = "半角英数"
                
                    '変数初期化
                    han_temp = ""
                    kana_temp = ""
                    kigo_temp = ""
                    num_temp = ""
                    
                    If set_text Like "* *" Then '半角スペース検索
                        Cells(i, space_cell).Value = "○"
                    End If
                    
                    '検証文字をばらす
                    For l_int_1 = 1 To Len(set_text)
                        my_temp = Mid(set_text, l_int_1, 1)
                        If my_temp Like "[a-z]" Or my_temp Like "[A-Z]" Then '半角英字の場合
                            han_temp = han_temp & my_temp
                            num_temp = add_comma(num_temp)
                            kana_temp = add_comma(kana_temp)
                            kigo_temp = add_comma(kigo_temp)
                            
                        ElseIf my_temp Like "[。-゚]" Then        '半角カナの場合
                            kana_temp = kana_temp & my_temp
                            num_temp = add_comma(num_temp)
                            han_temp = add_comma(han_temp)
                            kigo_temp = add_comma(kigo_temp)
                        
                        ElseIf my_temp Like "#" Then    '数字の場合
                            num_temp = num_temp & my_temp
                            han_temp = add_comma(han_temp)
                            kana_temp = add_comma(kana_temp)
                            kigo_temp = add_comma(kigo_temp)
                            
                        Else        'アルファベット以外
                            kigo_temp = kigo_temp & my_temp
                            han_temp = add_comma(han_temp)
                            kana_temp = add_comma(kana_temp)
                            num_temp = add_comma(num_temp)
                        
                        End If
                    Next
                                                                                       
                    Cells(i, hankaku_cell).Value = han_temp
                    Cells(i, hankana_cell).Value = kana_temp
                    Cells(i, kigo_cell).Value = kigo_temp
                    Cells(i, int_cell).Value = num_temp

                
            ElseIf VarType(set_text) = 7 Then   '項目が日付の時
                result = "日付"
                
            Else    '数字のみの場合、小数と整数に分ける
                If InStr(set_text, ".") Then
                    result = "数字(小数)"
                    Cells(i, int_cell).Value = "<ALL(小数)>"
                Else
                    result = "数字"
                    Cells(i, int_cell).Value = "<ALL>"
                End If
            End If
            
        ElseIf Len(set_text) * 2 = LenB(set_text_ansi) Then '全角
        
            my_temp = ""
            str_temp = ""
            hira_temp = ""
            zenkana_temp = ""
            
            '検証文字をばらす
            For l_int_1 = 1 To Len(set_text)
                my_temp = Mid(set_text, l_int_1, 1)
                    'ひらがな、カタカナ、長音、その他で処理を分ける
                    If my_temp Like "[あ-ん]" Then
                        hira_temp = hira_temp & my_temp
                        zenkana_temp = add_comma(zenkana_temp)
                        str_temp = add_comma(str_temp)
                    ElseIf my_temp Like "[ア-ン]" Then
                        zenkana_temp = zenkana_temp & my_temp
                        hira_temp = add_comma(hira_temp)
                        str_temp = add_comma(str_temp)
                    ElseIf my_temp Like "ー" Then
                        hira_temp = hira_temp & my_temp
                        zenkana_temp = zenkana_temp & my_temp
                        str_temp = add_comma(str_temp)
                    Else
                        str_temp = str_temp & my_temp
                        hira_temp = add_comma(hira_temp)
                        zenkana_temp = add_comma(zenkana_temp)
                    End If
            Next
                                           
            If set_text Like "* *" Then    '全角スペース検索
                Cells(i, space_cell).Value = "○"
            End If
            
            Cells(i, zenkaku_cell).Value = str_temp
            Cells(i, zenhira_cell).Value = hira_temp
            Cells(i, zenkana_cell).Value = zenkana_temp
            result = "全角文字"
            
        Else
            '半角全角混合の処理
            
            '初期化
            my_temp = ""
            str_temp = ""
            hira_temp = ""
            zenkana_temp = ""
            han_temp = ""
            kana_temp = ""
            kigo_temp = ""
            num_temp = ""
            
            '検証文字をばらす
            For l_int_1 = 1 To Len(set_text)
                my_temp = Mid(set_text, l_int_1, 1)
                If LenB(StrConv(my_temp, vbFromUnicode)) = 2 Then   '全角の場合
                
                    If my_temp Like "[あ-ん]" Then
                        hira_temp = hira_temp & my_temp
                        zenkana_temp = add_comma(zenkana_temp)
                        str_temp = add_comma(str_temp)
                    ElseIf my_temp Like "[ア-ン]" Then
                        zenkana_temp = zenkana_temp & my_temp
                        hira_temp = add_comma(hira_temp)
                        str_temp = add_comma(str_temp)
                    ElseIf my_temp Like "ー" Then
                        hira_temp = hira_temp & my_temp
                        zenkana_temp = zenkana_temp & my_temp
                        str_temp = add_comma(str_temp)
                    Else
                        str_temp = str_temp & my_temp
                        hira_temp = add_comma(hira_temp)
                        zenkana_temp = add_comma(zenkana_temp)
                    End If
                            
                    
                    han_temp = add_comma(han_temp)
                    han_temp = add_comma(han_temp)
                    kana_temp = add_comma(kana_temp)
                    kigo_temp = add_comma(kigo_temp)
                Else        '半角の場合
                    If my_temp Like "[a-z]" Or my_temp Like "[A-Z]" Then
                        han_temp = han_temp & my_temp
                        str_temp = add_comma(str_temp)
                        kana_temp = add_comma(kana_temp)
                        kigo_temp = add_comma(kigo_temp)
                        num_temp = add_comma(num_temp)
                    
                    ElseIf my_temp Like "[。-゚]" Then        '半角カナの場合
                        kana_temp = kana_temp & my_temp
                        han_temp = add_comma(han_temp)
                        kigo_temp = add_comma(kigo_temp)
                        num_temp = add_comma(num_temp)
                    
                    ElseIf my_temp Like "*#*" Then          '数字の場合
                        han_temp = add_comma(han_temp)
                        kana_temp = add_comma(kana_temp)
                        kigo_temp = add_comma(kigo_temp)
                        num_temp = num_temp & my_temp
                        
                    Else        'アルファベット以外
                        kigo_temp = kigo_temp & my_temp
                        han_temp = add_comma(han_temp)
                        kana_temp = add_comma(kana_temp)
                        num_temp = add_comma(num_temp)
                    End If
                                                                                       
                    str_temp = add_comma(str_temp)
                    hira_temp = add_comma(hira_temp)
                    zenkana_temp = add_comma(zenkana_temp)
                End If
            Next
            
            If set_text Like "* *" Or set_text Like "* *" Then
                Cells(i, space_cell).Value = "○"
            End If
            
            Cells(i, zenkaku_cell).Value = str_temp
            Cells(i, zenhira_cell).Value = hira_temp
            Cells(i, zenkana_cell).Value = zenkana_temp
            Cells(i, hankaku_cell).Value = han_temp
            Cells(i, hankana_cell).Value = kana_temp
            Cells(i, kigo_cell).Value = kigo_temp
            Cells(i, int_cell).Value = num_temp
            result = "混在"
            
        End If
        
        Cells(i, hantei_cell) = result

Continue:
    Next

End Sub

'分類分けで、続いている文字でなければカンマを挟むためのモジュール
Function add_comma(temp As Variant) As Variant
    
    If temp <> "" And Right(temp, 1) <> "," Then
        temp = temp & ","
    End If

    add_comma = temp
End Function

Tags: , , ,