にっきダイアリー

はてなダイアリーからはてなblogに移動してみました。

Excel VBA でカタカナを全角に、英数字&記号を半角にするマクロ

半角カナと全角英数字のない世界に行きたい。

' アクティブシートの選択しているセルを含む範囲内の半角カナを全角に、全角英数字を半角にする
' マクロの参照設定に "Microsoft VBScript Regular Expressions 5.5" を追加する
Sub han2zenkana()
    Dim r As Long, c As Long
    Dim re As RegExp
    Dim rng As Range
    Dim dat, rdat
    Dim m, matches
    
    Set re = New RegExp
    re.Global = True
    re.Pattern = "[A-Za-z0-9/.,() ]"
    
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set rng = Selection.CurrentRegion
    rng.Select
    For r = 1 To rng.Rows.Count
        For c = 1 To rng.Columns.Count
            dat = rng.Cells(r, c).Formula
            If InStr(dat, "=") <> 1 And Len(dat) > 0 Then ' 関数でない場合のみ
                dat = StrConv(dat, vbWide) ' 一度全て全角に
                Set matches = re.Execute(dat)
                For Each m In matches
                    dat = Replace(dat, m.Value, StrConv(m.Value, vbNarrow))
                Next m
                rng.Cells(r, c) = dat
                Debug.Print r & " " & dat
            End If
        Next c
    Next r
       
End Sub

追記:
以前書いたこのエントリの存在を忘れて正規表現使わないバージョンの関数書いてしまった。

' 指定したRange内の半角カナを全角に、全角英数字を半角にする
Function Han2Zen(rng As Range)
    Dim han, zen, c
    Dim i As Integer
    
    han = Array( _
    "ヴ", "ッ", "ャ", "ュ", "ョ", _
    "ガ", "ギ", "グ", "ゲ", "ゴ", _
    "ザ", "ジ", "ズ", "ゼ", "ゾ", _
    "ダ", "ヂ", "ヅ", "デ", "ド", _
    "バ", "ビ", "ブ", "ベ", "ボ", _
    "パ", "ピ", "プ", "ペ", "ポ", _
    "ア", "イ", "ウ", "エ", "オ", _
    "カ", "キ", "ク", "ケ", "コ", _
    "サ", "シ", "ス", "セ", "ソ", _
    "タ", "チ", "ツ", "テ", "ト", _
    "ナ", "ニ", "ヌ", "ネ", "ノ", _
    "ハ", "ヒ", "フ", "ヘ", "ホ", _
    "マ", "ミ", "ム", "メ", "モ", _
    "ヤ", "ユ", "ヨ", "ー", "・", _
    "ラ", "リ", "ル", "レ", "ロ", _
    "ワ", "ヲ", "ン", "「", "」", _
    "ァ", "ィ", "ゥ", "ェ", "ォ")

    zen = Array( _
    "ヴ", "ッ", "ャ", "ュ", "ョ", _
    "ガ", "ギ", "グ", "ゲ", "ゴ", _
    "ザ", "ジ", "ズ", "ゼ", "ゾ", _
    "ダ", "ヂ", "ヅ", "デ", "ド", _
    "バ", "ビ", "ブ", "ベ", "ボ", _
    "パ", "ピ", "プ", "ペ", "ポ", _
    "ア", "イ", "ウ", "エ", "オ", _
    "カ", "キ", "ク", "ケ", "コ", _
    "サ", "シ", "ス", "セ", "ソ", _
    "タ", "チ", "ツ", "テ", "ト", _
    "ナ", "ニ", "ヌ", "ネ", "ノ", _
    "ハ", "ヒ", "フ", "ヘ", "ホ", _
    "マ", "ミ", "ム", "メ", "モ", _
    "ヤ", "ユ", "ヨ", "ー", "・", _
    "ラ", "リ", "ル", "レ", "ロ", _
    "ワ", "ヲ", "ン", "「", "」", _
    "ァ", "ィ", "ゥ", "ェ", "ォ")

    For Each c In rng.Cells
        c.Value = Application.WorksheetFunction.Asc(c.Text)
    Next c
    
    With rng
        For i = 0 To 84
            .Replace What:=han(i), Replacement:=zen(i), LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Next i
    End With
End Function

こちらからは以上です。