Excel VBA セル内の文字列の数字だけなどを半角、全角にする

ポイント

配列で変換する文字列を決めます。
配列で決めた文字があるかどうかは、正規表現で決めます。
このためMicrosoft Vbscript Regular Expression 5.5を参照設定してください。
StrConvを使うと空白まで変換されるため、空白を除外するために作りました。

セル内の文字列のうち、全角の数字、かっこ、加減乗除記号だけを選択して半角にするマクロ

vb.net

Sub TransferWideNumber()
'かっこ()は除外してある
Const includeParenthes As Boolean = True
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim R As Range: Set R = ws.Range(ActiveCell.Address)
Dim buf As String
Dim i As Long, ar
Dim reg As RegExp: Set reg = New RegExp
If includeParenthes = True Then
ar = Split("1 2 3 4 5 6 7 8 9 0 = ≠ , . + - * ( ) { } [ ]", vbTab)
Else
ar = Split("1 2 3 4 5 6 7 8 9 0 = ≠ , . + - *", vbTab)
End If

If R.HasFormula = False And IsNull(R.Value) = False And IsEmpty(R.Value) = False And IsDate(R.Value) = False Then
With reg
.Global = True
.MultiLine = True
.IgnoreCase = False
If includeParenthes = True Then
.Pattern = "([0-9]|\+|\-|\/|\*|\=|≠|\.|,|\)|\(|\}|\{|\[|\])"
Else
.Pattern = "([0-9]|\+|\-|\/|\*|\=|≠|\.|,)"
End If
For Each R In Selection
If .Test(R.Value) = True Then
buf = R.Value
For i = LBound(ar) To UBound(ar)
buf = Replace(buf, ar(i), StrConv(ar(i), vbWide), 1, -1, vbTextCompare)
Next
R.Value = StrConv(buf, vbWide)
End If
Next R
End With
End If
End Sub

セル内の文字列のうち、全角の数字、かっこ、加減乗除記号だけを選択して半角にするマクロ

全角スペースを半角にしないにしない
ポイントは実際の変換文字列リストを配列で指定し、
配列で指定した文字があるかを正規表現で検索する。
その中に指定の文字があれば、対応する全角文字に変換する。
Strconvをかけるとすべて半角になってしまうので、選択的に半角にする。

vb.net

Sub TransferNarrowNumber()
'かっこ()は除外
Const includeParenthes As Boolean = True
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = ActiveSheet
Dim R As Range: Set R = ws.Range(ActiveCell.Address)
Dim buf As String, i As Long, ar
Dim reg As RegExp: Set reg = New RegExp
If R.HasFormula = False And IsNull(R.Value) = False And IsEmpty(R.Value) = False And IsDate(R.Value) = False Then
If includeParenthes = True Then
ar = Split("０,１,２,３,４,５,６,７,８,９,，,．,＊,＋,／,＝,≠,−,（,）,｛,｝,［,〕", ",")
Else
ar = Split("０,１,２,３,４,５,６,７,８,９,，,．,＊,＋,／,＝,≠,−", ",")
End If
With reg
.Global = True
.MultiLine = True
.IgnoreCase = False
If includeParenthes = True Then
.Pattern = "([０-９]|，|．|＊|＝|＋|／|−|（|）|｛|｝|［|〕)"
Else
.Pattern = "([０-９]|，|．|＊|＝|＋|／|−"
End If
For Each R In Selection
If .Test(R.Value) = True Then
buf = R.Value
For i = LBound(ar) To UBound(ar)
buf = Replace(buf, ar(i), StrConv(ar(i), vbNarrow), 1, -1, vbTextCompare)
Next i
R.Value = StrConv(buf, vbNarrow)
End If
Next R
End With
End If
End Sub