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
こちらからは以上です。