Excel VBA - 空白の結合

以下のようなExcelのシートがあります。
A2からC7を選択した後、マクロを走らせて空白セルを結合したいです。

　 A B C
1 (空白) DDD (空白)
2 ABC 123 (空白)
3 (空白)(空白)(空白)
4 DEF GHI DEF
5 (空白)(空白)(空白)
6 (空白) 789 123
7 (空白)(空白)(空白)
8 GHI JKL MNO

A3はA2と結合、A5,6,7はA4と結合、B列、C列も同様です。
要は、空白セルを上にある値の入ったセルと結合したいのです。
ただ、C2が選択範囲外のC1と結合すると困るので、先頭行の空白は、上の選択範囲外セルと結合しないようにしたいです。C2とC3は、結合しませんが、結合する仕様でも問題ありません。

(A2と同じ値をA3に入れた方がいいという意見があると思いますが、会社の表なので結合しないといけません。)

※以前、似たような質問をしましたが、少し違います。(これは未解決です。)

No.6 ベストアンサー 回答者： DOUGLAS_ 回答日時： 2009/03/13 23:06

[回答番号：No.3] の DOUGLAS_ です。

　失礼いたしました。問題をよく読んでおりませんでした。

＞A2からC7を選択した後
でしたね。

Sub Macro2()
　Dim R As Range
　For Each R In Selection
　　If R.Value = "" And R.Row <> Selection.Row Then _
　　R.Offset(-1).Resize(2).Merge
　Next
End Sub

この回答へのお礼

これを使わさせて頂きます!!
ありがとうございました!! (^^)

お礼日時：2009/03/16 23:43

No.5 回答者： web2525 回答日時： 2009/03/13 22:48

Sub test2()

While ActiveCell = ""
ActiveCell.Offset(1).Select
Wend
While ActiveCell <> "end"
rp = 1
With ActiveCell
While .Offset(rp).Value = ""
rp = rp + 1
Wend
Range(.Address & ":" & .Offset(rp - 1).Address).Merge
.Offset(1).Select
End With
Wend
End Sub

以前作ったマクロが見つかったので参考までに
最終行の各セルに終了を示すデータ"end"を入れないとシートの最終行まで結合してしまうのでご注意を

この回答へのお礼

具体的なマクロをありがとうございました。(^^)

お礼日時：2009/03/16 23:34

No.4 回答者： n-jun 回答日時： 2009/03/13 22:34

＃２です。

＞Set rs = Cells(Rows.Count, r.Column).End(xlUp)
Set rs = Cells(Rows.Count, r.Column).End(xlUp).Offset(-2)

各列で最終行が違うようなら、こちらに修正が必要かも。

この回答へのお礼

ありがとうございました。(^^)

お礼日時：2009/03/16 23:40

No.3 回答者： DOUGLAS_ 回答日時： 2009/03/13 22:32

　簡単なコードですので、不具合はご自分で微調整なさってください。

Sub Macro1()
　Dim i As Byte, j As Byte
　For i = 2 To 8
　　For j = 1 To 3
　　　If Cells(i, j) = "" Then Cells(i - 1, j).Resize(2).Merge
　　Next
　Next
End Sub

この回答へのお礼

ありがとうございました。(^^)

お礼日時：2009/03/16 23:41

No.2 回答者： n-jun 回答日時： 2009/03/13 21:46

Sub try()

Dim r As Range, rr As Range
Dim rs As Range

Application.DisplayAlerts = False
For Each r In Range("A3:C3")
Set rs = Cells(Rows.Count, r.Column).End(xlUp)

For Each rr In r.Range("A1:A" & rs.Row).SpecialCells(xlCellTypeBlanks).Areas
rr.Offset(-1).Resize(rr.Rows.Count + 1).Merge
Next

Next
Application.DisplayAlerts = True
End Sub

ご参考になれば。

この回答へのお礼

選択範囲外も結合されてしまいました。
ありがとうございました。(^^)

お礼日時：2009/03/16 23:37

No.1 回答者： web2525 回答日時： 2009/03/13 21:32

選択範囲を上から順にセル内容を検索

○空欄以外のセルを見つけたら次の空欄以外のセルが見つかるまでOffsetで下方向移動をループ
ループ数-1のセル範囲を結合
○へループ
範囲の下端に移動したら隣の列も同作業を繰り返す

こんな感じで組めば出来そうですが、いかがでしょうか？

この回答へのお礼

ヒントをありがとうございました。(^^)

お礼日時：2009/03/16 23:33