VBAの勉強を始めてみた

色々試しています。

指定文字以外を半角にする

仕事で資料などを作っている時、複数のセルの文字列をマクロでまとめて半角にしたいなーって思うことがあります。StrConv関数を使えば簡単にできるのですが、すべて半角になると見易さが失われる場合もあるため、指定文字列以外を半角にするっていうマクロを作ってみました。(内部的には一旦半角にしたうえで、指定文字を再度全角に戻すという処理をしています)

 

例としてA1、A3、A5セルを選択した状態で、マクロを実行します。

f:id:kouten0430:20180304000233j:plain

 

全角のを半角にしない文字列として指定してみます。(全角で指定する)

f:id:kouten0430:20180304000247j:plain

 

指定がなければすべて半角になります、A2、A4セルをすべて半角にしてみます。

f:id:kouten0430:20180304000303j:plain

 

もっと、スマートな方法があるかもしれないけど、とりあえずの掲載です。

 

 

Sub 指定文字以外を半角にする()
    '文字列を半角にしたいセルを選択(複数可)した状態で実行して下さい
    '指定文字は全角で指定して下さい
    '指定文字はセル参照とすることもできます
    Dim myRange As Range
    Dim i As Integer
    Dim n As Integer
    Dim V(99) As String
    
    For i = 0 To 99
        V(i) = Application.InputBox(Prompt:="半角にしない文字列を指定して下さい。" & vbCrLf & "(InputBoxが連続で表示され、複数指定できます。" _
        & vbCrLf & "これ以上指定がない場合は、ブランクでOKして下さい)", Type:=2)
    
        If V(i) = "" Then
            i = i - 1   '添え字の最大値からブランク分を除く
            Exit For
        ElseIf V(i) = "False" Then
            Exit Sub
        End If
    
    Next i
    
    For Each myRange In Selection.SpecialCells(xlCellTypeVisible)   '可視セルのみに処理を行う
        myRange.Value = StrConv(myRange.Value, vbNarrow)
        
        For n = 0 To i  '指定した文字列をすべて全角に復元する
            myRange.Value = Replace(myRange.Value, StrConv(V(n), vbNarrow), V(n))
        Next n

    Next myRange
    
End Sub

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