Excelでカタカナのみ全角半角変換するマクロ（改良版）

全角カタカナを半角にするマクロを先日作りました。
この記事で紹介したマクロは、固定列の処理でした。（A列のカタカナを変換して、B列に書き込む）

半角カナの存在はなくなりません。システム開発の現場でバリバリ使われています。Excel関数では「半角カナのみ変換」という関数は存在しないので、マクロでの変換処理が必要です。

しかし実際にExcelでドキュメント作成をしていると、「選択したセルだけ変換したい」という場面が多いです。
そのため、ソースコードを少し改良しました。

カタカナを、全角から半角に変換するマクロ

Sub 全角カナ⇒半角カナ変換()
    '
    ' JIS関数は、アルファベットや記号も全角にしてしまうので、
    ' 半角カナ限定で、半角⇔全角 の変換ができるマクロ
    '
    Dim c As Range          '選択範囲のループ用
   
    Dim myStr As String
    Dim Match As Object, Matches As Object
   
    If TypeName(Selection) = "Range" Then

        With CreateObject("VBScript.RegExp")
            .Pattern = "[\u30A1-\u30FF]+"           '全角カナを文字コードで指定
            .Global = True
       
            For Each c In Selection
                myStr = c.Value
                If Len(myStr) > 0 Then
                    Set Matches = .Execute(myStr)
                    'マッチしたすべての文字列を置換
                    For Each Match In Matches
                        myStr = Replace(myStr, Match.Value, _
                            StrConv(Match.Value, vbNarrow))     '全角⇒半角
                    Next Match
                    'セルに反映
                    c.Value = myStr
                End If
            Next c
        End With
    End If
End Sub

カタカナを、半角から全角に変換するマクロ

Sub 半角カナ⇒全角カナ変換()
    '
    ' JIS関数は、アルファベットや記号も全角にしてしまうので、
    ' 半角カナ限定で、半角⇔全角 の変換ができるマクロ
    '
    Dim c As Range          '選択範囲のループ用
   
    Dim myStr As String
    Dim Match As Object, Matches As Object
   
    If TypeName(Selection) = "Range" Then

        With CreateObject("VBScript.RegExp")
            .Pattern = "[\uFF61-\uFF9F]+"           '半角カナを文字コードで指定
            .Global = True
       
            For Each c In Selection
                myStr = c.Value
                If Len(myStr) > 0 Then
                    Set Matches = .Execute(myStr)
                    'マッチしたすべての文字列を置換
                    For Each Match In Matches
                        myStr = Replace(myStr, Match.Value, _
                            StrConv(Match.Value, vbWide))       '半角⇒全角
                    Next Match
                    'セルに反映
                    c.Value = myStr
                End If
            Next c
        End With
    End If
End Sub

このマクロを、リボン登録すれば簡単に実行できます。