選択範囲の全角英数字、全角カタカナ、全角スペースを半角に変換し、連続するスペースは1つにまとめ、先頭と末尾のスペースを削除します。

建築みつも郎 建築みつも郎_VBA
建築みつも郎
見積書を提出する際に、全角と半角の文字が混在していたり、無駄な空白があると見にくくなります。
以下のコードを使用すれば、見栄えが良くなります。半角カタカナは見積書にだけ使用します。
文書には使わないので、これは見積書向けです。
半角カタカナは、文字の幅が漢字サイズの半分で表示される文字で、限られたスペースに文字を押し込むために使用されます。
ただし、半角カタカナが新聞などのマスメディアや公文書に使われることはありません。

標準モジュール

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

 

 

 

コメント