【Excel】半角と全角の変換マクロ⑧【VBA】

　要するにやりたかったのはこれです。

　セルを全選択しても、数十万個のデータに対して処理をかけても、数秒で完了します。

Sub 全角に変換する()
    t = Timer
    Call xStrConv(ReduceRangeR(ReduceRangeC(Selection)), vbWide)
    Application.StatusBar = "　全角に変換しました。 " _
                            & Timer - t & " 秒"
End Sub

Sub 半角に変換する()
    t = Timer
    Call xStrConv(ReduceRangeR(ReduceRangeC(Selection)), vbNarrow)
    Application.StatusBar = "　半角に変換しました。 " _
                            & Timer - t & " 秒"
End Sub

Private Function ReduceRangeC(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    Set f = Application.WorksheetFunction
    
    NewColumn = c1
    For c = c2 To c1 Step -1
        If f.CountA(Range(Cells(r1, c), Cells(r2, c))) > 0 Then
            NewColumn = c
            GoTo xxx
        End If
    Next c
xxx:
    
    Set ReduceRangeC = Range(Cells(r1, c1), Cells(r2, NewColumn))
End Function

Private Function ReduceRangeR(a1 As Range) As Range
    r1 = a1.Row
    c1 = a1.Column
    r2 = a1.Rows.Count + r1 - 1
    c2 = a1.Columns.Count + c1 - 1
    
    NewRow = r1
    For c = c1 To c2
        If Len(Cells(r2, c)) > 0 Then
            NewRow = r2
            GoTo xxx
        End If
        r = Cells(r2, c).End(xlUp).Row
        If r > NewRow Then
            NewRow = r
        End If
    Next c
xxx:

    Set ReduceRangeR = Range(Cells(r1, c1), Cells(NewRow, c2))
End Function

Private Sub xStrConv(a1, a2)
    If Not TypeName(a1) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    End If
    
    If a1.Count = 1 Then
        x = StrConv(a1.FormulaLocal, a2)
        GoTo xxx
    End If
    
    RowsCount = a1.Rows.Count
    ColumnsCount = a1.Columns.Count
    r1 = a1.Row
    c1 = a1.Column
    r2 = RowsCount + r1 - 1
    c2 = ColumnsCount + c1 - 1
    
    x = Range(Cells(r1, c1), Cells(r2, c2)).FormulaLocal
    
    For r = 1 To RowsCount
        For c = 1 To ColumnsCount
            x(r, c) = StrConv(x(r, c), a2)
        Next c
    Next r

xxx:
    a1.Value = x
End Sub