カタカナや英数だけ半角にしたり全角にしたり

ワークシート関数のASC関数を使うと全角文字を半角に、逆にJIS関数を使うと半角を全角に…
って変換出来るんですが、英数だけ半角にしたい!とかカタカナだけ全角にしたい!ってのが
出来ないんですよね。な訳で、既出なんでしょうけど、例の如く作っちゃいました。

ソース

Option Explicit

'カタカナのみ全角⇔半角化したり、
'英数のみ全角⇔半角化したりする自作ワークシート関数
'引数
' Target   : 変換対象セル
' ConvChar : 変換対象文字 A…英字、N…数字、AN…英数、K…カタカナ
' ConvMode : 変換モード ZH…全角→半角 HZ…半角→全角

Function MYCONV(Target As Range, ConvChar As String, ConvMode As String) As String

    Dim re         As Object
    Dim strPattern As String
    Dim Matches    As Object
    Dim m          As Object
    Dim buf        As String
    Dim lngMode    As Long
    
    On Error Resume Next
    
    buf = Target.Value
    ConvChar = StrConv(UCase(ConvChar), vbNarrow)
    ConvMode = StrConv(UCase(ConvMode), vbNarrow)
    
    '引数のチェック
    If TypeName(Target) <> "Range" Then
        GoTo Finally
    End If
    If Target.Count > 1 Then
        GoTo Finally
    End If
    If Not (ConvChar = "A" Or ConvChar = "N" Or ConvChar = "AN" Or ConvChar = "K") Then
        GoTo Finally
    End If
    If Not (ConvMode = "ZH" Or ConvMode = "HZ") Then
        GoTo Finally
    End If
        
    '変換対照文字に応じてパターン文字列を生成
    Select Case ConvChar
        Case "A"
            If ConvMode = "ZH" Then
                strPattern = "[Ａ-Ｚａ-ｚ]+"
            Else
                strPattern = "[A-Za-z]+"
            End If
        Case "N"
            If ConvMode = "ZH" Then
                strPattern = "[０-９]+"
            Else
                strPattern = "[0-9]+"
            End If
        Case "AN"
            If ConvMode = "ZH" Then
                strPattern = "[Ａ-Ｚａ-ｚ０-９]+"
            Else
                strPattern = "[A-Za-z0-9]+"
            End If
        Case Else
            If ConvMode = "ZH" Then
                strPattern = "[ァ-ヴ]+"
            Else
                strPattern = "[･-ﾟ]+"
            End If
    End Select
    
    '変換モードに応じてStrconvの引数を設定
    If ConvMode = "ZH" Then
        lngMode = 8 'vbNarrow
    Else
        lngMode = 4 'vbWide
    End If

    '正規表現をバインド
    Set re = CreateObject("VBScript.RegExp")

    With re
        .Pattern = strPattern
        .Global = True
        Set Matches = .Execute(buf)
        For Each m In Matches
            buf = Replace(buf, m.Value, StrConv(m.Value, lngMode))
        Next m
    End With
    
    MYCONV = buf
    
Finally:
    Set m = Nothing
    Set Matches = Nothing
    Set re = Nothing

End Function

手抜きなもんで、引数間違って入力すると空白を返すだけです(；^ω^)

数式の入力方法

=MYCONV(対象セルのアドレス,変換対象文字,変換モード)

変換対象文字

A ･･･ アルファベットのみ変換、N ･･･ 数字のみ変換、AN ･･･ 英数を変換、K ･･･ カタカナのみ変換

変換モード

ZH ･･･ 全角→半角、HZ ･･･ 半角→全角

絵がちっちゃいですが、関数使い慣れてる人なら↓見て頂くとわかってもらえるかと。

家帰ったら、アドインにして実験部屋にupします。

よければ

ダウンロードはここからどうぞ。