2015年8月
            1
2 3 4 5 6 7 8
9 10 11 12 13 14 15
16 17 18 19 20 21 22
23 24 25 26 27 28 29
30 31          

最近のトラックバック

最近買った本(Amazon.co.jp)

広告(Amazon.co.jp)

広告(Google AdSense)

無料ブログはココログ

カテゴリー「VBA」の1件の記事

2011年9月25日 (日)

Excel/VBA入門: 英数字を半角に変換し、半角カナを全角に変換する。

以前、某所に掲載したものの改良版です。

ワークシートに入力された文字列について、英数字や片仮名のように半角(1Byte)と全角(2Byte)の文字が存在するものをどちらか一方に統一したいということが良くある。この場合、VBAのStrConv関数を使用して全てのセルの文字列を一括変換すれば良い。

str = StrConv(str, vbNarrow) ' 文字列を半角(1Byte)に変換する。
str = StrConv(str, vbWide)   ' 文字列を全角(2Byte)に変換する。

しかし、英数字は半角に統一したいが、「いわゆる半角カナ」などと呼ばれ過去に多くの問題を引き起こしてきた半角カナ(0xA1-0xCF)だけは全角に変換したいという場合、StrConvなどの既存の関数では一度に変換できないため、少し工夫が必要となる。

というわけで、英数字を半角に変換し、半角カナを全角に変換するプロ-シージャーを作成してみた。

Sub ToHankakuWithoutKatakana()
    '
    ' 現在のワークシートの値が入力されている全てのセルについて、
    ' 半角変換可能な全角文字を全て半角に変換する。
    ' ただし、半角カナ(0xA1-0xCF)については全角に変換する。
    ' また、可能であればカナ文字と直後の濁点・半濁点が合成される。
    '
    ' 2011/09/25 hichon: 新規作成。
    '
    Dim re As Object
    Dim Cell As Range
    Dim Str As String
    Dim Match As Object

    '
    ' 正規表現オブジェクトを作成する。
    ' 1文字以上の半角カナ(0xA1-0xCF)を検索対象とする。
    '
    Set re = CreateObject("VBScript.RegExp")
    re.Pattern = "[。-゚]+"
    re.Global = True

    '
    ' 値が入力されている全てのセルについて、変換処理を実行する。
    ' 尚、値が入力されているセルが存在しない場合、エラーとなる。
    '
    On Error GoTo Error
    For Each Cell In Cells.SpecialCells(xlCellTypeConstants, xlTextValues)

        Str = Cell.Value
        If Str <> "" Then

            '
            ' 半角変換可能な文字を半角に変換する。
            ' 全角カナもいったん半角カナに変換される。
            '
            Str = StrConv(Str, vbNarrow)

            '
            ' 半角カナを全角に変換する。
            ' 半角カナの直後に濁点・半濁点があればここで合成される。
            '
            For Each Match In re.Execute(Str)
                Str = Replace(Str, Match, StrConv(Match, vbWide), , 1)
            Next
            Cell.Value = Str

        End If
 
    Next

    Exit Sub

Error:
    MsgBox Err.Description

End Sub