Excel VBAでSelection(選択範囲)を列単位、行単位で処理する

ExcelのVBAで選択されているセル範囲を列単位、行単位で処理する方法について書いてみます。


選択範囲を処理する方法

Excelで選択された範囲をVBAではApplication.SelectionでRangeオブジェクトとして取得できます。Selectionの処理方法について検索すると次のようなページがヒットします。

選択範囲の操作

しかし、この方法では、一つの行に対して列数分だけ繰り返し同じ処理が行われてしまいます。また、ユーザーがCtrlキーを押しながら複数の範囲(Area)を指定した場合には破綻します。

ちなみに、Selection.Rows.Countは最初のエリア(Area)しかCountの対象としません。残りのエリアは対象外です。

Range.Rows プロパティ (Excel)


単純な行番号比較はだめ

Selection のアイテム番号は左上から右方向に振られているように見えたので次のプロシージャを実行してみましたがダメでした。

Sub uWrong()
    Dim uCell As Range
    Dim uMax As Long
    
    For Each uCell In Selection
        If uCell.Row > uMax Then
            uMax = uCell.Row
            uCell = 1
        End If
    Next
End Sub

未処理の行があります。

次のプロシージャーで、selection で取得した順番を表示してみました。

Sub uFillAll()
    Dim uCell As Range
    Dim i As Long
    
    For Each uCell In Selection
        i = i + 1
        uCell = i
    Next
End Sub

結果は次の通り。

これは次の順番でCtrlキーを押しながら範囲を選択したためです。

このように、Selectionは指定したエリア順に処理されるようで、上から順番に処理されるわけではないようです。

SelectionはRangeのコレクションを順番に返しているだけなのでしょう。そういう意味では、コード中のuCellはuRangeとすべきだろうと思いました。


処理した行番号を保存して処理済みかチェックする

やむを得ないので、処理した行を記録して、処理済みかどうかチェックしながら処理する事にしました。

記録にはCollectionを使用しています。

Sub uFillRowOnce()
    Dim uCell As Range
    Dim uColl As Collection
    Dim i As Long
    
    Set uColl = New Collection
    
    For Each uCell In Selection
        If Not uContains(uCell.Row, uColl) Then
            i = i + 1
            uCell = i
            uColl.Add uCell.Row
        End If
    Next
End Sub

こちらは値がコレクションに含まれているかどうかのチェックを行う関数。

Function uContains(ByVal uValue As Variant, ByRef uColl As Collection) As Boolean
    Dim uItem As Variant
    
    For Each uItem In uColl
        If uItem = uValue Then
            uContains = True
            Exit Function
        End If
    Next
End Function

うまく選択されました。

こちらは列単位で処理するバージョン

Sub uFillColumnOnce()
    Dim uCell As Range
    Dim uColl As Collection
    Dim i As Long
    
    Set uColl = New Collection
    
    For Each uCell In Selection
        If Not uContains(uCell.Column, uColl) Then
            i = i + 1
            uCell = i
            uColl.Add uCell.Column
        End If
    Next
End Sub

うまく処理できています。

ただし、この方法だと行が処理される順番はエリアの指定順次第になります。Collectionはソートには不向きだと思うので、配列のバージョンも考えてみました。

Sub uFillRowOnceArrayVer()
    Dim uArea As Range
    Dim uRows As Long
    Dim uRow As Range
    Dim uCell As Range
    Dim uRowArray() As Long
    Dim i As Long
    Dim ii As Long
    
    For Each uArea In Selection.Areas
        uRows = uRows + uArea.Rows.Count
    Next

    ReDim uRowArray(uRows)
    
    For Each uCell In Selection
        If Not uContainsArray(uCell.Row, uRowArray) Then
            uRowArray(i) = uCell.Row
            i = i + 1
            uCell = i
        End If
    Next
    
    For ii = 0 To i - 1
        Debug.Print uRowArray(ii)
    Next
End Sub

配列に含まれているかどうかをチェックする関数。

Function uContainsArray(ByVal uValue As Variant, ByRef uArray As Variant) As Boolean
    Dim i As Long
    For i = LBound(uArray) To UBound(uArray)
        If uArray(i) = uValue Then
            uContainsArray = True
            Exit Function
        End If
    Next
End Function

Debug.Printの結果は次の通りで、期待通りです。

 1  2  3  4  6  7  8  9  5 

これをソートすれば、順番に並んだ処理すべき行番号の出来上がりです。ソート方法は次のサイトなどを参考にするとよいでしょう。

VBA 配列の並び替え

なお、最初のFor文では、Areaの行数を合計しています。本当はSelection.Rows.CountでSelectionの真の(実際に使用している)行数が取れると良いのですが、上にかいたようにSelection.Rows.Countが返すのは最初のエリアの行数のみです。

とりあえずオーバーフローさえしなければよいかと上のようなコードを書いてみました。


というわけで、Selectionで指定された範囲を重複なく行単位、列単位で処理する方法でした。



コメント

アクセスランキング(過去30日間)

Amazon Prime Videoで4K UHD映画を検索する方法

iPhone 12 Proと iPhone 8 Plusのサイズを比較

Excel 2019 クエリが原因で日本語入力の一文字目が勝手に確定する

Microsoft Flight Simulator (2020)のPS4コントローラー設定

Teamsで日本語入力すると左上に変換ウィンドウが出る

Buffalo 外付けUSB HDD HD-AD6U3 を購入しました

iPhone 12 Pro Maxでも裸族かも

コールマン タフスクリーンタープ/400 を購入しました

DELL 31.5インチ 4K HDR モニター U3219Q を購入

テントやタープなど防水製品には寿命がある