同じ値のセルを結合する～再び～
同じ値の連続セルを結合する
年度末の後始末及び次年度の準備をしていく中で、だいぶ前
で作成したメソッドに重大な欠陥があることに気付いたので、根本からやり直した。
重大な欠陥
前回のやり方は、セルを上から順にスキャンして、一つ下のセルと値を比較して結合すべきセルかどうかを判定していた。
これがまずかった。
このやり方だと、一番最後のセルは、指定した範囲の外側のセルと値を比較することになるので、たとえば
こんなふうに、指定した範囲の一番下が空白セルと接しているような選び方なら問題ないのだけれど、たとえば
こんなふうに範囲を指定して、
こんな結果にしたいときでも
こんな状態になってしまう。
これは、
一つ下に値の異なったセルが見つかったら、結合条件を満たして結合
というやり方だったのが原因だ。
つまり、指定した範囲の一番下のセルの値が、その一つ下のセルの値と同じであるために、結合条件が満たされず、最後に出てきた同じ値の連続セルが結合されずに残ってしまうのだ。
要するに、もともとの設計がなっていなかったのだ。
これはいかん。
そこで、根本から書き直すことにした。
修正後のコード
まずは、修正後のコードをば。
リスト１ 標準モジュール
Public Function mergeSameValueCellsV( _
ByVal targetrange As Range) As Boolean '……(1)'
mergeSameValueCellsV = False '……(2)'
On Error GoTo Finalizer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
End With
'ガード節'
With targetrange '……(3)'
If targetrange.Columns.Count > 1 Then GoTo Finalizer
If .Count = 1 Then _
mergeSameValueCellsV = True: GoTo Finalizer
End With
'メイン'
Dim startRow As Long '……(4)'
startRow = 1
Dim endRow As Long
endRow = 1
Dim i As Long
With targetrange '……(5)'
For i = 2 To targetrange.Rows.Count
If .Item(i - 1).Value <> .Item(i, 1).Value Then '……(6)'
Call Range(.Item(startRow), .Item(endRow)).Merge
startRow = i '……(7)'
End If
endRow = i '……(8)'
Next
Call Range(.Item(startRow), .Item(endRow)).Merge '……(9)'
End With
mergeSameValueCellsV = True '……(10)'
'後始末'
Finalizer:
Err.Clear
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Function
まずは、(1)の
Public Function mergeSameValueCellsV( _
ByVal targetrange As Range) As Boolean
にあるように、Functionにした。処理が上手くいけばTrueを返すようにしている。
ヨコ方向に同様のことをすることはないと思うけれど、一応タテ方向の処理に特化したメソッドであることを示すために、メソッド名の末尾に「V」を加えた。
冒頭(2)の
mergeSameValueCellsV = False
でデフォルトの返り値を設定。そもそもBoolean型のデフォルト値はFalseなので、必要ないといえば必要ないのだが、明示的に書いておくのはgood mannerだと思う。
これで、何か不具合があったときに即returnすれば良い。
で、メインの処理に入る前に引数チェック。(3)の
With targetrange
If targetrange.Columns.Count > 1 Then GoTo Finalizer
If .Count = 1 Then _
mergeSameValueCellsV = True: GoTo Finalizer
End With
がガード節。このメソッドは１列のセル範囲を受け取ることが前提なので、引数targetrangeのColumnsプロパティの値が2以上だったら、即Falseを返す。
あと、範囲内にセルが一つしかない場合は、何もする必要はないけれど、さりとて処理に失敗したわけでもない（何もしないことが意図どおりの結果である）わけだから、即Trueを返すようにした。
そして、ここからがメインの処理。
まず、(4)からの４行
Dim startRow As Long startRow = 1 Dim endRow As Long endRow = 1
で、二つの変数を用意。
この二つの変数で、セル結合の開始位置と終了位置を指定することにする。
（この程度のことを書くのに4行も使ってしまうところがVBAのイマイチなところですね……。）
これで準備は完了。
いよいよ(5)からの10行、
With targetrange
For i = 2 To targetrange.Rows.Count
If .Item(i - 1).Value <> .Item(i, 1).Value Then '……(6)'
Call Range(.Item(startRow), .Item(endRow)).Merge
startRow = i '……(7)'
End If
endRow = i '……(8)'
Next
Call Range(.Item(startRow), .Item(endRow)).Merge '……(9)'
End With
で必要に応じてセルを結合していく。
Forループで、二つ目のセルから下へ下へと回していく。つまり、常に一つ上のセルと比較するようにした。これで、最後まで回しても指定した範囲を飛び出すことはない。
(6)からの4行
If .Item(i - 1).Value <> .Item(i, 1).Value Then Call Range(.Item(startRow), .Item(endRow)).Merge startRow = i '……(7)' End If
で、セルの値を一つ上のセルの値と比較。
値が異なっていれば、結合条件発動なので、範囲内のstartRow番目のセルからendRow番目のセルまでを結合する。
ループ開始時のstartRowとendRowの値は、(4)で設定したようにともに「1」なので、一つ目のセルの値と二つ目のセルの値が異なっていたら、一つ目のセルと一つ目のセルを結合することになり、すなわち見た目上変化しないことになる。
(7)にあるように、結合が済んだら、その時点のiの値をstartRowに設定する。
そして、
If .Item(i - 1).Value <> .Item(i, 1).Value Then
の条件が成立していようがいまいが、ループで回すごとに(8)の
endRow = i
でendRowにiの値をセットしておく。
今回のやり方だと、常に一つ上のセルの値との比較である関係上、一番最後のセルは比較されることがないまま終わってしまう。
従って、たとえば最後に同じ値の連続セルがあったとしたら、結合されないまま放置されてしまう。
そこで、(9)の
Call Range(.Item(startRow), .Item(endRow)).Merge
でForループから抜けた時点のstartRowとendRowの値を用いて最後の結合を行う。
Forループから抜けた直後のendRowには、最後のセルの位置が格納されているので、これでうまくいくはずだ。
ここまで来れば、無事に処理は終わっているということなので、あとは(10)の
mergeSameValueCellsV = True
で返り値をTrueにして、後始末をして終わり。
使ってみる
次のコードで実行。
リスト２ 標準モジュール
Public Sub test01() Call mergeSameValueCellsV(Selection) End Sub
別に、イミディエイト・ウインドウでの実行でも良かったんですけどｗ
こんなふうになります。
おわりに
セル結合といえば、いわゆる「ネ申エクセル」のもとでもあり、忌み嫌われる傾向ですが、データはデータとして別シートに持たせておき、適宜必要なデータを〈見せるためのシート〉に転記して、そのシート上でセル結合かますのなら許容範囲かなあ、と思っています。
