'選択範囲の文字列を全角半角変換するマクロ

Option Explicit

'半角文字へ変換するマクロ
Sub ChangeByteNarrow()
    Application.ScreenUpdating = False
    ChangeByte vbNarrow
    Application.ScreenUpdating = True
End Sub

'全角文字へ変換するマクロ
Sub ChangeByteWide()
    Application.ScreenUpdating = False
    ChangeByte vbWide
    Application.ScreenUpdating = True
End Sub

Sub ChangeByte(conversion As Integer)
    Dim r As Range
    Dim v As Variant

    If TypeName(Selection) <> "Range" Then Exit Sub

    '対象範囲の確定
    Set r = Application.Intersect(ActiveSheet.UsedRange, Selection)
    If r Is Nothing Then Exit Sub
    r.Select

    For Each r In Selection.Cells
        v = r.Value
        If Not IsEmpty(v) Then
            If Not r.HasFormula Then
                '文字列値の場合だけ変換する
                Select Case VarType(v)
                    Case vbString
                        r.Value = r.PrefixCharacter & StrConv(v, conversion)
                    Case vbDouble
                        If r.NumberFormat = "@" Then
                            r.Value = StrConv(v, conversion)
                        End If
                End Select
            End If
        End If
    Next
End Sub


'文字列を半角に変換し、コードが128以上の文字を全角に変換するマクロ
Sub ChangeByteSpecial()
    Dim r As Range
    Dim v As Variant

    If TypeName(Selection) <> "Range" Then Exit Sub

    '対象範囲の確定
    Set r = Application.Intersect(ActiveSheet.UsedRange, Selection)
    If r Is Nothing Then Exit Sub
    r.Select

    If MsgBox("選択範囲の文字列を半角に変換し、" & _
        "コードが128以上の文字を全角に変換します。", _
        vbExclamation Or vbOKCancel) <> vbOK Then Exit Sub

    Application.ScreenUpdating = False

    For Each r In Selection.Cells
        v = r.Value
        If Not IsEmpty(v) Then
            If Not r.HasFormula Then
                '文字列値の場合だけ変換する
                Select Case VarType(v)
                    Case vbString
                        r.Value = r.PrefixCharacter & ChangeByteA(v)
                    Case vbDouble
                        If r.NumberFormat = "@" Then
                            r.Value = ChangeByteA(v)
                        End If
                End Select
            End If
        End If
    Next

    Application.ScreenUpdating = True

End Sub


'文字列を半角に変換し、コードが128以上の文字を全角に変換する関数
Function ChangeByteA(ByVal sText As String) As String
    Dim sResult As String
    Dim bStart As Boolean
    Dim iStart As Integer
    Dim i As Integer

    sText = StrConv(sText, vbNarrow)
    sResult = ""
    bStart = False
    iStart = 1
    For i = 1 To Len(sText)
        If Asc(Mid$(sText, i, 1)) <= 127 Then
            If bStart Then
                sResult = sResult & StrConv(Mid$(sText, iStart, i - iStart), vbWide)
                bStart = False
                iStart = i
            End If
        Else
            If Not bStart Then
                sResult = sResult & Mid$(sText, iStart, i - iStart)
                bStart = True
                iStart = i
            End If
        End If
    Next
    If bStart Then
        ChangeByteA = sResult & StrConv(Mid$(sText, iStart), vbWide)
    Else
        ChangeByteA = sResult & Mid$(sText, iStart)
    End If
End Function