VBAでカタカナ（または数字・英字・記号）のみを全角（または半角）にする

今回はVBAを使って、エクセルに入力された文字列のうち、カタカナ（または数字・英字・記号）のみを全角（または半角）にしてみようと思います。
これがどんな時に役立つかというと･･････、カタカナや英字や数字や記号のみを半角全角にしたい時です(*｀・ω・)※そのまんま
かんたんなのでさっそくやってみましょう！

目次

数字のみを変換する

◇全角→半角

Sub 数字のみ半角にする()
    '選択範囲に対して処理を行います
    Dim myRange As Range
    Dim i As Integer

    For Each myRange In Selection
        For i = 1 To Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[０-９]" Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i, 1, _
                StrConv(Mid(myRange.Value, i, 1), vbNarrow))
            End If
        Next i
    Next myRange
    
End Sub

一発目なので簡単に説明します。セル内の文字列を左端から１文字ずつ、全角数字かそうでないかを調べ、全角数字であれば半角数字に変換します。これを右端まで繰り返します。右端まで行ったら、次のセルに処理が移ります。とっても愚直です。

◇半角→全角

Sub 数字のみ全角にする()
    '選択範囲に対して処理を行います
    Dim myRange As Range
    Dim i As Integer

    For Each myRange In Selection
        For i = 1 To Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[0-9]" Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i, 1, _
                StrConv(Mid(myRange.Value, i, 1), vbWide))
            End If
        Next i
    Next myRange
    
End Sub

説明省略。

英字のみを変換する

◇全角→半角

Sub 英字のみ半角にする()
    '選択範囲に対して処理を行います
    Dim myRange As Range
    Dim i As Integer

    For Each myRange In Selection
        For i = 1 To Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[Ａ-Ｚａ-ｚ]" Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i, 1, _
                StrConv(Mid(myRange.Value, i, 1), vbNarrow))
            End If
        Next i
    Next myRange
    
End Sub

説明省略。

◇半角→全角

Sub 英字のみ全角にする()
    '選択範囲に対して処理を行います
    Dim myRange As Range
    Dim i As Integer

    For Each myRange In Selection
        For i = 1 To Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[A-Za-z]" Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i, 1, _
                StrConv(Mid(myRange.Value, i, 1), vbWide))
            End If
        Next i
    Next myRange
    
End Sub

説明省略。

カタカナのみを変換する

◇全角→半角

Sub カタカナのみ半角にする()
    '選択範囲に対して処理を行います
    '「－」は、ひらがなとカタカナ区別なく半角にします。半角にしたくない場合、ァ-ヶの後のーを消去して下さい
    Dim myRange As Range
    Dim i As Integer

    For Each myRange In Selection
    
        i = 1
    
        Do While i <= Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[ァ-ヶー]" Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i, 1, _
                StrConv(Mid(myRange.Value, i, 1), vbNarrow))
            End If
            
            i = i + 1
            
        Loop
    Next myRange
    
End Sub

濁点・半濁点が付くカタカナを半角にすると、１文字増える（例えば「ガ」を半角にすると、「ｶ」と「ﾞ」の２文字になる）ので、ループ回数が固定であるFor ～NextではなくDo While ～Loopを使っています。 お節介かもしれませんが、長音符号を含む、例えば「ラーメン」を変換すると「ﾗーﾒﾝ」になってしまうので、「ﾗｰﾒﾝ」になるように「－」も変換対象にしてます。

◇半角→全角

Sub カタカナのみ全角にする()
    '選択範囲に対して処理を行います
    Dim myRange As Range
    Dim i As Integer
    Dim cnt As Integer
    Dim 濁 As Integer

    For Each myRange In Selection
    
        i = 1
    
        Do While i <= Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[ｦ-ﾟ]" Then
                cnt = cnt + 1
                If Mid(myRange.Value, i, 1) Like "[ﾞﾟ]" Then
                    濁 = 濁 + 1 '濁点と半濁点の数をカウントする
                End If
            ElseIf cnt > 0 Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i - cnt, cnt, _
                StrConv(Mid(myRange.Value, i - cnt, cnt), vbWide))
                i = i - 濁: 濁 = 0 '濁点と半濁点の数をiから引く
                cnt = 0
            End If
            
            i = i + 1
            
        Loop
        
        If cnt > 0 Then
            myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i - cnt, cnt, _
            StrConv(Mid(myRange.Value, i - cnt, cnt), vbWide))
            濁 = 0
            cnt = 0
        End If

    Next myRange
    
End Sub

１文字ずつ変換すると、ｶﾞ→カ゛のようにカタカナと濁点・半濁点がそれぞれ全角になってしまいます。ということで、左端から１文字ずつ調べ、半角のカタカナと半角の濁点・半濁点が連続する間は、その数をカウントするだけにします。連続が途切れたら、そこまでをまとめて変換します（まとめて変換すれば、ガのように１文字のカタカナになる）。濁点と半濁点の分だけ文字数が減るので、iからマイナスします。

記号のみを変換する

◇全角→半角

Sub 記号のみ半角にする()
    '選択範囲に対して処理を行います
    Dim myRange As Range
    Dim i As Integer

    For Each myRange In Selection
    
        i = 1
    
        Do While i <= Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[!0-9０-９A-Za-zＡ-Ｚａ-ｚァ-ヶｦ-ﾟ]" Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i, 1, _
                StrConv(Mid(myRange.Value, i, 1), vbNarrow))
            End If
            
            i = i + 1
            
        Loop
    Next myRange
    
End Sub

正確に言うと、数字・英字・カタカナではないものを変換します。

◇半角→全角

Sub 記号のみ全角にする()
    '選択範囲に対して処理を行います
    Dim myRange As Range
    Dim i As Integer

    For Each myRange In Selection
    
        i = 1
    
        Do While i <= Len(myRange.Value)
            If Mid(myRange.Value, i, 1) Like "[!0-9０-９A-Za-zＡ-Ｚａ-ｚァ-ヶｦ-ﾟ]" Then
                myRange.Value = Application.WorksheetFunction.Replace(myRange.Value, i, 1, _
                StrConv(Mid(myRange.Value, i, 1), vbWide))
            End If
            
            i = i + 1
            
        Loop
    Next myRange
    
End Sub

説明省略。

以上です。とくに処理が速くなるような工夫はしていないので、膨大なセル数を変換対象にすると時間がかかるかもしれません。（PCのスペックによって差があります）

※コードの使用方法

SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら。