標準モジュール
Private Sub 選択範囲の全角等を変換_Click()
Dim ws As Worksheet
Dim cell As Range
Dim inputStr As String
Dim outputStr As String
Dim rng As Range ' 範囲を表す変数を追加
' アクティブなワークシートを取得
Set ws = ActiveSheet
' 選択されているすべてのセルをループ
For Each cell In Selection
' セルの値を取得
inputStr = cell.value
' 全角カタカナを半角カタカナに変換
outputStr = CnvZenKanaToHan(inputStr)
' 全角空白を半角空白に変換
outputStr = Replace(outputStr, " ", " ")
' 連続する空白を1個の空白にする
outputStr = Application.WorksheetFunction.Trim(outputStr)
' 変換後の値をセルに設定
cell.value = outputStr
Next cell
' 複数範囲のセル内の全角数字を半角数字に、全角英字を半角英字に変更する
Set rng = Selection ' 範囲を選択されたセル範囲として設定
For Each cell In rng
If Not IsEmpty(cell.value) Then
inputStr = cell.value
' 全角空白を半角空白に変換
inputStr = Replace(inputStr, " ", " ")
' 連続する空白を1個の空白にする
inputStr = Application.WorksheetFunction.Trim(inputStr)
' 全角を半角に変換
outputStr = StrConv(inputStr, vbNarrow)
' 変換後の値をセルに設定
cell.value = outputStr
End If
Next cell
'MsgBox "変換が完了しました。", vbInformation
Me.Hide
End Sub
Private Function CnvZenKanaToHan(ByVal strZen As String) As String
'カタカナ⇒カタカナ変換して返す
Dim strHanList As Variant, strZenList As Variant
strHanList = Array("ガ", "ギ", "グ", "ゲ", "ゴ", "ザ", "ジ", "ズ", "ゼ", "ゾ", "ダ", "ヂ", "ヅ", "デ", "ド", "バ", "ビ", "ブ", "ベ", "ボ", "パ", "ピ", "プ", "ペ", "ポ", _
"。", "「", "」", "、", "・", "ヲ", "ァ", "ィ", "ゥ", "ェ", "ォ", "ャ", "ュ", "ョ", "ッ", "ー", "ア", "イ", "ウ", "エ", "オ", "カ", "キ", "ク", "ケ", "コ", "サ", "シ", "ス", "セ", "ソ", _
"タ", "チ", "ツ", "テ", "ト", "ナ", "ニ", "ヌ", "ネ", "ノ", "ハ", "ヒ", "フ", "ヘ", "ホ", "マ", "ミ", "ム", "メ", "モ", "ヤ", "ユ", "ヨ", "ラ", "リ", "ル", "レ", "ロ", "ワ", "ン")
strZenList = Array("ガ", "ギ", "グ", "ゲ", "ゴ", "ザ", "ジ", "ズ", "ゼ", "ゾ", "ダ", "ヂ", "ヅ", "デ", "ド", "バ", "ビ", "ブ", "ベ", "ボ", "パ", "ピ", "プ", "ペ", "ポ", _
"。", "「", "」", "、", "・", "ヲ", "ァ", "ィ", "ゥ", "ェ", "ォ", "ャ", "ュ", "ョ", "ッ", "ー", "ア", "イ", "ウ", "エ", "オ", "カ", "キ", "ク", "ケ", "コ", "サ", "シ", "ス", "セ", "ソ", _
"タ", "チ", "ツ", "テ", "ト", "ナ", "ニ", "ヌ", "ネ", "ノ", "ハ", "ヒ", "フ", "ヘ", "ホ", "マ", "ミ", "ム", "メ", "モ", "ヤ", "ユ", "ヨ", "ラ", "リ", "ル", "レ", "ロ", "ワ", "ン")
'置換処理
Dim i As Long
For i = LBound(strHanList) To UBound(strHanList)
strZen = Replace(strZen, strZenList(i), strHanList(i))
Next
CnvZenKanaToHan = strZen
End Function
コメント