エクセル2013vbaで結合セルが空白なら行非表示

いつもお世話になってます。
エクセル2013のvbaで質問です。

下記コードで、D8セルからD列の表の最後のセルまでに空白セルがあれば、その行を非表示になるようにしたいのですが、表のすべてが非表示になってしまいます。

D列が結合セルになっているのが、影響しているようなのですが、どうすればいいかいきづまりました。

結合の範囲は、D8:D12、D13:D17・・・と5行毎になっています。それで、例えばD8:D12は空白で、D13:D17には10、D18:D22には15・・・などと入力されているとすると、空白である8行目～12行目のみ非表示にしたいと思っています。
Cells(8, 4).MergeArea(1, 1)に指定すれば結合セルの最初の行のみを拾うので、うまくいくと思ったのですがだめでした。D8セルの値をみて、D9～D12は飛ばしてD13の値を見て、D18を見る・・みたいな。

どのように修正すればよろしいでしょうか？
すいませんがお願いいたします。

Sub sample()
Dim MaxRow As Long
Dim i As Long
Dim Rr As Range, buf As Range

Application.ScreenUpdating = False

MaxRow = Range("C" & Rows.Count).End(xlUp).Row - 3 '表の最終行

For Each Rr In Range(Cells(8, 4).MergeArea(1, 1), Cells(MaxRow, 4).MergeArea(1, 1))
On Error Resume Next
If Rr = "" Then '範囲にあるセルの値が空白ならば
If buf Is Nothing Then Set buf = Rr
Set buf = Union(buf, Rr)
End If
Next

If Not buf Is Nothing Then
buf.EntireRow.Select 'bufに格納したセルの行を選択
Selection.EntireRow.Hidden = True '選択した行を非表示にする
End If

Application.ScreenUpdating = True

End Sub

質問者からの補足コメント

• 早速の回答ありがとうございます。
  確認しました。別のやり方ですが、この方法でうまく動作しました。
  どうもありがとうございました。
  質問のコードではすべて非表示になってしまいましたが、どの部分がまずかったのでしょうか？

  No.2の回答に寄せられた補足コメントです。 補足日時：2015/04/15 23:09

No.4 ベストアンサー 回答者： tom04 回答日時： 2015/04/16 11:18

何度もごめんなさい。

おそらく結合セル数が不規則な場合でも対応したいコードだと思いますので、
お示しのコードの1行だけを訂正すれば大丈夫だと思います。

Sub sample()
Dim MaxRow As Long
Dim i As Long
Dim Rr As Range, buf As Range

Application.ScreenUpdating = False

MaxRow = Range("C" & Rows.Count).End(xlUp).Row - 3 '表の最終行

For Each Rr In Range(Cells(8, 4), Cells(MaxRow, 4))

If Rr.MergeArea(1, 1) = "" Then '//★（←この行のみ変更）
If buf Is Nothing Then Set buf = Rr
Set buf = Union(buf, Rr)
End If
Next

If Not buf Is Nothing Then
buf.EntireRow.Select 'bufに格納したセルの行を選択
Selection.EntireRow.Hidden = True '選択した行を非表示にする
End If

Application.ScreenUpdating = True

End Sub

※　コード内の「★」の行だけの問題かと・・・
前回の書いたように
＞For Each Rr In Range(Cells(8, 4).MergeArea(1, 1), Cells(MaxRow, 4).MergeArea(1, 1))
はセルの結合があってもなかっても範囲内の1セルずつをループするようですので、
＞ For Each Rr In Range(Cells(8, 4), Cells(MaxRow, 4))
としても同じみたいです。

結局結合セルの「空っぽのセル」もループしてしまうので、
＞If Rr = "" Then '範囲にあるセルの値が空白ならば
を
＞If Rr.MergeArea(1, 1) = "" Then '//★（←この行のみ変更）
とすれば、「空っぽのセルの結合範囲内」というコトになるので
問題は解決するのではないでしょうか？m(_ _)m

この回答へのお礼

ばっちりうまくいきました。
判定方法を変更すればよかったのですね。
お手数をおかけしました。
この度も何度も回答していただき、どうもありがとうございました。

お礼日時：2015/04/16 22:49

No.3 回答者： tom04 回答日時： 2015/04/16 08:51

No.1です。

＞質問のコードではすべて非表示になってしまいましたが、どの部分がまずかったのでしょうか？

基本的に他人様がお考えになったコードについてのコメントはあまりやりたくないのですが、

まず、
＞For Each Rr In Range(Cells(8, 4).MergeArea(1, 1), Cells(MaxRow, 4).MergeArea(1, 1))
は
D8～最終行までのすべてのセルをループさせていますので
セルの結合があるなしにかかわらず、「すべてのセルが空白かどうか？」というループです。
すなわち
＞For Each Rr In Range(Cells(8, 4), Cells(MaxRow, 4))
と同じコトになります。

No.1で書いたように結合セルのセル番地は結合されている最初のセル番地になり
結合セルのその他は「空白状態」です。
結局お示しのコードでは結合セルはすべて空白セルとなり
それらをUNIONでまとめ、最後に一気に非表示にしているコードになっていますので
結論としてすべての行が非表示になると思います。

結合セルがある場合は特に注意が必要です。
5行毎に結合している！というコトですので、
Step 5　という操作が必要なのですが、
＞For Each Rr In Range・・・
では　Step 5　は使えないと思いますので、極力お示しのコードに基づいてやってみました。

Sub sample()
Dim MaxRow As Long
Dim i As Long
Dim Rr As Range, buf As Range
Dim cnt As Long '//←追加★
Application.ScreenUpdating = False
MaxRow = Range("C" & Rows.Count).End(xlUp).Row - 3 '表の最終行
For Each Rr In Range(Cells(8, 4).MergeArea(1, 1), Cells(MaxRow, 4).MergeArea(1, 1))
cnt = cnt + 1 '//★
If cnt Mod 5 = 1 Then '//★
If Rr = "" Then '範囲にあるセルの値が空白ならば
If buf Is Nothing Then Set buf = Rr
Set buf = Union(buf, Rr)
End If
End If '//★
Next Rr
If Not buf Is Nothing Then
buf.EntireRow.Select 'bufに格納したセルの行を選択
Selection.EntireRow.Hidden = True '選択した行を非表示にする
End If
Application.ScreenUpdating = True
End Sub

※　お示しのコードを元に考えると
こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

結局セルの結合があるなしにかかわらず、「すべてのセルが空白かどうか？」というループで判定してしまうのですね。どうもありがとうございました。
サンプルコードもきちんと動作しました。

お礼日時：2015/04/16 22:46

No.2 回答者： tom04 回答日時： 2015/04/15 22:20

No.1です。

たびたびごめんなさい。
質問のコードをよく確認していませんでした。
＞MaxRow = Range("C" & Rows.Count).End(xlUp).Row - 3 '表の最終行
でちゃんと最終行を取得していましたね。
ごめんなさい。

↓のコードに変更してください。

Sub Sample2()
Dim i As Long
Dim Maxrow As Long
Maxrow = Cells(Rows.Count, "C").End(xlUp).Row - 3
For i = 8 To Maxrow Step 5
If Cells(i, "D") = "" Then
Cells(i, "D").MergeArea.EntireRow.Hidden = True
End If
Next i
End Sub

どうも失礼しました。m(_ _)m

この回答へのお礼

どうもありがとうございました。

お礼日時：2015/04/16 22:43

No.1 回答者： tom04 回答日時： 2015/04/15 22:14

こんばんは！

＞結合の範囲は、D8:D12、D13:D17・・・と5行毎になっています
すなわちD列は必ず5行が結合してあるわけですね？
そうであればごく単純に

Sub Sample1()
Dim i As Long
For i = 8 To Cells(Rows.Count, "D").End(xlUp).Row Step 5
If Cells(i, "D") = "" Then
Cells(i, "D").MergeArea.EntireRow.Hidden = True
End If
Next i
End Sub

としてみてはどうでしょうか？

※　結合セルのセル番地は最初のセル番地になりますので、
5行おきに検索してやればOKだと思います。

※　データの最終行の取得方法が質問だけでは判らないのでとりあえずD列で最終行を取得しています。
最終行が空白の場合は非表示になりません。m(_ _)m

この回答へのお礼

シンプルで分かりやすかったです。
どうもありがとうございました。

お礼日時：2015/04/16 22:41