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のコレクションを順番に返しているだけなのでしょう。
UNIQUEとSORTを使う
2022/12/10 追記
このページがそれなりにヒットしているので見直してみたところ、もっと簡単な方法があることに気が付きました。今どきの Excel の場合、 UNIQUE と SORT が使えます。それを使って、作り直してみました。
コード：
Public Sub uGetSelectedRows()
Dim uSelected As Range
Dim uRowNumbers() As Long
Dim i As Long
Dim uUnique() As Variant
Dim uSorted() As Variant
Const uColumn As Boolean = True
Const uAscend As Integer = 1
For Each uSelected In Selection
ReDim Preserve uRowNumbers(i)
uRowNumbers(i) = uSelected.Row
i = i + 1
Next
uUnique = WorksheetFunction.Unique(uRowNumbers, uColumn)
uSorted = WorksheetFunction.Sort(uUnique, 1, uAscend, uColumn)
End Sub
実行結果：
サクッとできました。
選択されたセルの行番号をuRowNumbersに保存し、それをUniqueで重複排除して、Sortで並べ替えています。
uSortedを使えば、選択されたセルの行を上から順番に重複せずに処理していくことができます。列順に処理したいならば、uSelected.RowをuSelected.Columnに変更します。
1次元配列は、列方向とみなされるようなので、基準に列指定（uColumn=True）を行っています。最初この指定をしなかったら、ユニークにならず、？でした。
参考にしたのは次のページです。
VBAでシート関数使用時の配列要素数制限 Excelの神髄
SORT関数でデータを並べて取り出す できるネット
以降は前回作成した内容です。ご参考までに。
処理した行番号を保存して処理済みかチェックする
やむを得ないので、処理した行を記録して、処理済みかどうかチェックしながら処理する事にしました。
記録には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で指定された範囲を重複なく行単位、列単位で処理する方法でした。
コメント
コメントを投稿