全角の英数字・記号を半角に置換する(書式とカタカナは維持)

セル内の全角の英数字と記号を半角に変換します。

ASC関数ではカタカナも半角になってしまいますが、このマクロでは全角のままにします。また、セルごと変換する方法では文字単位の書式がリセットされてしまいますが、このマクロでは維持します。

全角半角変換

文字書式と全角カタカナを維持して全角・半角置換

マクロコード

セル内の全角文字を半角にする関数
'引数 rngOrg : 1セルのRange
Function f_NarrowChar(rngOrg As Range)

  Dim cntChr As Long, i As Long
  
  '数式セルは処理しない
  If rngOrg.HasFormula Then Exit Function
  
  '文字数を取得
  On Error Resume Next
  cntChr = rngOrg.Characters.Count
  '文字列以外(数値など)は処理しない
  If Err.Number <> 0 Then
    Err.Clear
    Exit Function
  End If
  On Error GoTo 0
  
  '1文字ずつ半角化
  For i = 1 To cntChr
    With rngOrg.Characters(i, 1)
      If Not (.Text >= "ァ" And .Text <= "ヶ") Then
        .Text = StrConv(.Text, vbNarrow)
      End If
    End With
  Next i

End Function
呼び出し元のサンプル
Public Sub ブック中の文字を半角化()
  Dim aCell As Range
  For Each aCell In ActiveSheet.UsedRange.Cells
    f_NarrowChar aCell
  Next aCell
End Sub

関数のコード解説

1セルのRangeを引数に持つ関数です。

数式は対象外

数式はファイルパスなど一律に半角化すると不具合になるものもあるので、対象外としています。

If rngOrg.HasFormula Then Exit Function

Characers で文字数の取得と文字種判定

Range.Charactersで文字数を取得しています。Rangeの値が数値や日付などの場合はエラーなるので文字種判定にも利用しています。

On Error でエラー状態の制御

On Error Resume Next でエラーが発生しても処理を続行させるようにします。
On Error GoTo 0 で通常のエラー対応(処理の中断)に戻します。

Err.Number <> 0 (エラーあり)で処理を分岐します。

Err.Clear でエラー状態をクリアして次のエラーを取得できるようにします。

1文字ずつ処理して書式を維持

Range.Characters(i, 1).Text で1文字範囲の取得・変更が可能なおかけでこのマクロは成立しています。Range.Text でしか取得・変更できないオブジェクトでは、文字単位の書式が維持できません。

StrConv(.Text, vbNarrow)で、現在の1字を半角に変換します。半角化できないものは同じ文字が返ります。

カタカナを除外

全角カタカナは”ァ”~”ヶ”(全角小文字)の範囲なのでこれを除外します。ちなみに半角の”ヶ”はありませんが、まとめて指定して問題ありません。

タイトルとURLをコピーしました