こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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に入れた方がいいという意見があると思いますが、会社の表なので結合しないといけません。)

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

投稿日時 - 2009-03-13 21:18:03

QNo.4794196

暇なときに回答ください

質問者が選んだベストアンサー

[回答番号: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-13 23:06:47

お礼

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

投稿日時 - 2009-03-16 23:43:00

このQ&Aは役に立ちましたか?

1人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.5

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-13 22:48:24

お礼

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

投稿日時 - 2009-03-16 23:34:52

ANo.4

#2です。

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

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

投稿日時 - 2009-03-13 22:34:56

お礼

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

投稿日時 - 2009-03-16 23:40:49

ANo.3

 簡単なコードですので、不具合はご自分で微調整なさってください。
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-13 22:32:21

お礼

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

投稿日時 - 2009-03-16 23:41:37

ANo.2

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-13 21:46:12

お礼

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

投稿日時 - 2009-03-16 23:37:42

ANo.1

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

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

投稿日時 - 2009-03-13 21:32:18

お礼

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

投稿日時 - 2009-03-16 23:33:44

あなたにオススメの質問