選択範囲処理

筆者はこれらを SelectionSheetModule, SelectionCellModule に記述し、コマンド入力(※)で実行している。
※コマンド入力については後日記述予定

変更履歴的なにか

2013/01/12

数式が設定されているシート上で実行すると極めて遅くなっていたのを是正。
処理実行前に計算方法を手動にし、処理実行後に計算方法を元に戻している。
描画抑制はまだいいか。遅い局面に出くわしたらやる。

コード

選択シート

' 選択シート名を全角にする
' 選択シート名を半角にする
' 選択シート名を大文字にする
' 選択シート名を小文字にする

選択セル

Option Explicit

Private OriginalCalculation As Variant  ' 元の計算方法

' 選択セルのテキストを全角にする
Public Function ToWide()
    Dim Target As Excel.Range
    SetCalculationManual
    For Each Target In Selection
        Target.Value = StrConv(Target.Value, vbWide)
    Next
    SetCalculationOriginal
End Sub

' 選択セルのテキストを半角にする
Public Function ToNarrow()
    Dim Target As Excel.Range
    SetCalculationManual
    For Each Target In Selection
        Target.Value = StrConv(Target.Value, vbNarrow)
    Next
    SetCalculationOriginal
End Sub

' 選択セルのテキストを大文字にする
Public Function ToUpper() As Boolean
    Dim Target As Excel.Range
    SetCalculationManual
    For Each Target In Selection
        Target.Value = UCase$(Target.Text)
    Next
    SetCalculationOriginal
End Function

' 選択セルのテキストを小文字にする
Public Function ToLower() As Boolean
    Dim Target As Excel.Range
    SetCalculationManual
    For Each Target In Selection
        Target.Value = LCase$(Target.Text)
    Next
    SetCalculationOriginal
End Function

' 選択セルの結合状態を切り替える
Public Function ChangeMergeStatus() As Boolean
    If Selection.MergeCells Then
        Dim Target As Excel.Range
        For Each Target In Selection
            Target.MergeCells = False
        Next
    Else
        Selection.MergeCells = True
    End If
End Function

' 選択セルの式をテキストにする
' コピー > 形式を選択して貼り付け > 値 > OK と同様の効果
Public Function FormulaToText() As Boolean
    Dim Target As Excel.Range
    SetCalculationManual
    For Each Target In Selection
        Target.Value = Target.Text
    Next
    SetCalculationOriginal
End Function

' 選択セルの値を分割する
' 選択範囲が 1 行 n 列または n 行 1 列でなければ何もしない
Public Function CellSplit(Optional ByVal Delimiter As String = " ") As Boolean
    
    If Selection.Rows.Count > 1 And Selection.Columns.Count > 1 Then
        Exit Function
    End If

    Dim i As Long
    Dim Target As Excel.Range
    Dim Values() As String
    If Selection.Columns.Count = 1 Then
        '横に展開する
        For Each Target In Selection
            Values = Split(Target.Value, Delimiter)
            For i = 0 To UBound(Values)
                ActiveSheet.Cells(Target.Row, Target.Column + i + 1).Value = Values(i)
            Next
        Next
    Else
        '縦に展開する
        For Each Target In Selection
            Values = Split(Target.Value, Delimiter)
            For i = 0 To UBound(Values)
                ActiveSheet.Cells(Target.Row + i + 1, Target.Column).Value = Values(i)
            Next
        Next
    End If

End Function

Public Function CellSplitEx(ByRef Args() As String) As Boolean
    
    CellSplit Args(0)

End Function

'----------------------------------------
' 自動計算抑制関連
'----------------------------------------
' 計算方法を手動にする
Private Function SetCalculationManual() As Boolean
    OriginalCalculation = Application.Calculation
    Application.Calculation = xlCalculationManual
End Function

' 計算方法を元に戻す
Private Function SetCalculationOriginal() As Boolean
    Application.Calculation = OriginalCalculation
End Function

  • 最終更新:2013-01-12 15:41:11

このWIKIを編集するにはパスワード入力が必要です

認証パスワード