【VBA】1桁の数字は全角文字に、2桁以上の数字は半角文字にする【Excel版】

Option Explicit
'1桁数字を全角に、2桁以上の数字を半角にする
Public Sub 全角半角変換()
    
    Dim c As Variant
    Dim Reg As Object
    
    '処理開始
    Call StartProgram(Reg)
    
    '各セルに対して処理を実施
    For Each c In Selection
        '一つ一つのセルに対して全角半角変換を実行
        Call Width2HalfConversion(c, Reg)
    Next c

    '処理終了
    Call EndProgram(Reg)
End Sub
'処理開始
Private Sub StartProgram(ByRef Reg As Object)
    Set Reg = CreateObject("VBScript.RegExp")
End Sub

'一つ一つのセルに対して全角半角変換を実行
Private Sub Width2HalfConversion(ByRef c As Variant, ByRef Reg As Object)
    Dim oMatches As Object
    Dim oMatch As Object
    Dim lCount As Long
    Dim ii As Long
    Dim stAfter As String
    Dim stConv As String
    
    'パラメータ設定
    Reg.Global = True   '検索範囲は文字列の最後まで
    Reg.IgnoreCase = True   '大文字小文字は区別しない
    
    '連続した数字(13桁まで対応。間にカンマやピリオドを含む)
    Reg.Pattern = "[0-9０-９,，.．]{2,13}"
    
    Set oMatches = Reg.Execute(c.Value)
    lCount = oMatches.Count
    stAfter = c.Value
    
    For ii = 0 To lCount - 1
        Set oMatch = oMatches.Item(ii)
        stConv = StrConv(oMatch.Value, vbNarrow)
        
        stAfter = Replace(stAfter, oMatch.Value, stConv)
    Next ii
    
    '単体の数字
    '正規表現を使わず、1文字1文字チェックしていく
    'すでにここまでに連続する数値は半角になっている前提
    Dim Buf As String, flg As Boolean, lLen As Long

    lLen = Len(stAfter) '文字列の長さを把握
    flg = False         '数値スイッチはオフ
    For ii = 1 To lLen
        Buf = Mid(stAfter, ii, 1)   '1文字分をBufに格納
        If IsNumeric(Buf) And Not flg Then  '1文字が数値であり、直前の文字の数値スイッチがオフなら
            If Not IsNumeric(Mid(stAfter, ii + 1, 1)) And "." <> Mid(stAfter, ii + 1, 1) And "," <> Mid(stAfter, ii + 1, 1) Then
                '直後の1文字が、数値でもピリオドでもカンマでもないなら
                Mid(stAfter, ii, 1) = StrConv(Buf, vbWide)  '全角数字に変換
            End If
        End If
        flg = IsNumeric(Buf)    '数値スイッチに現在の文字の判定を格納
    Next ii
    
    c.Value = stAfter
End Sub

'処理終了
Private Sub EndProgram(ByRef Reg As Object)
    Set Reg = Nothing
End Sub