2010年6月13日日曜日

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

 疲れたので、きちんとした速度測定は次回(笑)。でも多分更に高速化されているはず。
Sub 全角に変換する()
    If Not TypeName(Selection) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    End If
    
    t = Timer
    
    Call ExStrConv(Selection, vbWide)
    
    Application.StatusBar = _
        ("全角に変換しました。 " & Timer - t & " 秒")
End Sub

Sub 半角に変換する()
    If Not TypeName(Selection) = "Range" Then
        MsgBox ("セルを選択して下さい")
        Exit Sub
    End If
    
    t = Timer
    
    Call ExStrConv(Selection, vbNarrow)
    
    Application.StatusBar = _
        ("半角に変換しました。 " & Timer - t & " 秒")
End Sub

Private Sub ExStrConv(a1 As Range, a2)
    If a1.Count = 1 Then
        '選択セルが一つだけの場合の処理
        'x As String
        
        x = StrConv(a1.FormulaLocal, a2)
    
    Else
        '選択セルが二つ以上の場合の処理
        'x As Variant()
        
        With a1
            r1 = .Row
            c1 = .Column
            r2 = .Rows.Count + r1 - 1
            c2 = .Columns.Count + c1 - 1
            RowsCount = .Rows.Count
            ColumnsCount = .Columns.Count
        End With
        
        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
    
    End If
    
    a1.Value = x
End Sub

0 件のコメント:

コメントを投稿