栗鼠と珈琲

そこかしこに溢れ出した栗鼠、珈琲のお菓子など、記録してます。

半角カナを全角にする(VBAマクロで変換)

仕事において表計算ソフトは今や欠かせない存在になりました。
かくいう私もその一人です。
今日は、やりたかったことが実現できたので、その備忘録。
今日もまた「リスでもない珈琲でもない」話、excelVBAマクロ)のことです。


■やりたいこと
 01.特定のセルに「カナ」が入力されたら「全角カナ」に変換する
 02.特定のセルに「英字」が入力されたら「半角英字」に変換する
 03.特定のセルに「数字」が入力されたら「半角数字」に変換する


■可変前の記述

この記述「vbUpperCase」でアルファベットを「大文字」に変換していますが
「vbNarrow」で「半角」に変換しているため「カナ」までもが
「半角」に変換されてしまうのです。
そうじゃないんだよ。カナだけは全角にしたいんだよ。何とかならないかねぇー。
インターネットで色々見たのですが、
まだまだ知識が浅い私にはVBAのソースが難解(>_<)。
何度も何度も見ました。そして何度も可変しながら動作確認を繰り返しました。
で、ようやく出来ました。嬉しかったーーー。
嬉しくて喜びを露わに出してしまいましたよ。
間違いなく「もっとシンプルでスマートな書き方(記述)」があるでしょう。
でも今の私には、これが精いっぱい。
それでもここまで書ければ十分。進歩かな(笑顔)。


■ここから

excelを開く
 名前を付けて保存→ファイル形式をexcelマクロ有効ブック(.xlsm)にする→
 保存→開発タブをクリック(無い場合は、ファイル→オプション→
 リボンのユーザ設定→メインタブから開発をチェック)

VisualBasicをクリック
 利用者が入力するシート
 (ここでは、Sheet1(Sheet1)を想定)ダブルクリック、以下記述を貼付
-------------------------------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)

'行削除した場合は「Exit Sub」でプロシージャから抜ける記述が必要
    With Target
        If .Count Mod Rows.Count = 0 Or .Count Mod Columns.Count = 0 Then Exit Sub
    End With


'------------------------------------------------------------------------------------------
'E、F、G列「商品分類(略称)」が30桁を超えたらエラーメッセージを返す
'------------------------------------------------------------------------------------------

    Dim myStrBr As String
    Dim BryakLen As Long
    BryakLen = 30


'E、F、G列「商品分類(略称)」に小文字が入力されたら半角大文字に変換する

    Dim myRngBr As Range
    Application.EnableEvents = False
    For Each myRngBr In Target
        If Not Intersect(myRngBr, Range("E5:G500")) Is Nothing Then
            myRngBr.Value = StrConv(myRngBr, vbUpperCase + vbNarrow)
      ’↑■■ココの記述で大文字と半角を指定■■
        End If
    Next
    Application.EnableEvents = True
    

'シート名「商品CD_標準/E、F、G列:商品分類(略称)」の値を取得

    With Worksheets("商品CD_標準")
        myStrBr = .Cells(Target.Row, Target.Column).Value
    End With

'E、F、G列「商品分類(略称)」の桁数チェックを行う
'E、F、G列「商品分類(略称)」の半角チェックを行う

        If (Target.Row >= 5 And Target.Row <= 500) And (Target.Column >= 5 And Target.Column <= 7) Then
            If LenB(StrConv(myStrBr, vbFromUnicode)) > BryakLen Then
                    MsgBox "商品分類(略称)は、" & _
                "「" & BryakLen & "文字」以内で入力してください。" & vbCrLf & _
                "アルファベット「A」~「Z」、数字は半角、平仮名は全角です。" _
                            , vbOKOnly + vbExclamation, "商品分類(略称):入力エラー"
                Exit Sub
            End If
        End If
End Sub

-------------------------------------------------------------------------------------------


■可変後の記述

可変後は、まず英字を何が入力されても半角大文字に変換。
と同時に数字も、ここで半角文字に変換しています。
次のstepで、カナを全角に変換する記述を書きました。
カナ(記号を含む)は「[。-゚]」で表されています。所謂、正規表現てやつです。
正規表現だと視認性が挙がるので分かり易く書き易くなりますね。
[○○]で囲われている箇所が正規表現です。
英数字であれば
 →  Like "[A-Za-z0-9]" Then (○○の文字が含まれていたらの意)
カナ文字であれば
 → Like "[。-゚]" Then  (カナ一部記号を含む文字が含まれていたらの意)


■ここから

excelを開く
 名前を付けて保存→ファイル形式をexcelマクロ有効ブック(.xlsm)にする→
 保存→開発タブをクリック(無い場合は、ファイル→オプション→
 リボンのユーザ設定→メインタブから開発をチェック)

VisualBasicをクリック
 利用者が入力するシート
 (ここでは、Sheet1(Sheet1)を想定)ダブルクリック、以下記述を貼付
-------------------------------------------------------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)

'行削除した場合は「Exit Sub」でプロシージャから抜ける記述が必要
    With Target
        If .Count Mod Rows.Count = 0 Or .Count Mod Columns.Count = 0 Then Exit Sub
    End With


'------------------------------------------------------------------------------------------
'E、F、G列「商品分類(略称)」が30桁(15文字)を超えたらエラーメッセージを返す
'------------------------------------------------------------------------------------------

    Dim myStrBr As String
    
    Dim myRngBrEiSuji As Range
    Dim myRngBrKanaKigo As Range
    
    Dim BryakLen As Long
    BryakLen = 15
    
    Dim i As Integer


Application.EnableEvents = False
'------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------
'E、F、G列「商品分類(略称)」に英字が入力されたら半角大文字に変換
'E、F、G列「商品分類(略称)」に数字が入力されたら半角文字に変換
'------------------------------------------------------------------------------------------
    
    For Each myRngBrEiSuji In ActiveSheet.Range("E5:E500")
    
        For i = 1 To Len(myRngBrEiSuji.Value)
        
            If Mid(myRngBrEiSuji.Value, i, 1) Like "[A-Za-z0-9]" Then
                myRngBrEiSuji.Value = Application.WorksheetFunction. _
        Replace(myRngBrEiSuji.Value, i, 1, _
                StrConv(Mid(myRngBrEiSuji.Value, i, 1), vbNarrow + vbUpperCase))
            End If
        
        Next
        
    Next myRngBrEiSuji
    
'------------------------------------------------------------------------------------------
'E、F、G列「商品分類(略称)」にカナ(記号を含む)が入力されたら全角文字に変換
'------------------------------------------------------------------------------------------

    For Each myRngBrKanaKigo In ActiveSheet.Range("E5:E500")
    
        For i = 1 To Len(myRngBrKanaKigo.Value)
        
            If Mid(myRngBrKanaKigo.Value, i, 1) Like "[。-゚]" Then
                myRngBrKanaKigo.Value = Application.WorksheetFunction. _
        Replace(myRngBrKanaKigo.Value, i, 1, _
                StrConv(Mid(myRngBrKanaKigo.Value, i, 1), vbWide))
            End If
        
        Next
        
    Next myRngBrKanaKigo

'------------------------------------------------------------------------------------------
Application.EnableEvents = True


'------------------------------------------------------------------------------------------
'E、F、G列「商品分類(略称)」が15文字を超えたらエラーメッセージを返す
'------------------------------------------------------------------------------------------

'シート名「商品CD_標準/E、F、G列:商品分類(略称)」の値を取得
    With Worksheets("商品CD_標準")
        myStrBr = .Cells(Target.Row, Target.Column).Value
    End With

'E、F、G列「商品分類(略称)」の桁数チェックを行う
'E、F、G列「商品分類(略称)」の半角チェックを行う

        If (Target.Row >= 5 And Target.Row <= 500) And (Target.Column >= 5 And Target.Column <= 7) Then
            If Len(StrConv(myStrBr, vbFromUnicode)) > BryakLen Then
                    MsgBox "商品分類(略称)は、" & _
                "「" & BryakLen & "文字」以内で入力してください。" & vbCrLf & _
                "アルファベット「A」~「Z」、数字は半角、平仮名は全角です。" _
                            , vbOKOnly + vbExclamation, "商品分類(略称):入力エラー"
                Exit Sub
            End If
        End If
End Sub