エクセルのマクロで指定条件一致行をグループ化したい

エクセル２００７を使用しています。
次の様なシートで、特定列で条件（ブランク）に一致する行を一括して
グループ化するコードを教えてください。

　　　　　Ａ　　　　　　　Ｂ　　　　　　Ｃ　　　　　　　D
1　　　 コード　　科目　　　　　　実績　　　予算
2　　　5000 　販売収入　　　　100　　　　90
3　　　5001　　受取手数料　　　
4　　　5002　　その他収入
5 　　　　　【売上高】 100　　　　90


この様な会計の管理帳票で、1シート約800行あり、シートが部門毎に
全部で約100シートが一つのブックに収めてあります。

全部のシートに対して、例えばＣ列がブランクの行を一括してグループ化
させる様なマクロのコードを教えていただきたいと思います。
（この場合だと3～4行目）

他の部門では使わない補助科目が多く、折りたたまないと使い物に
ならないため、現在は手作業で行っております。

どうぞよろしくお願い致します。　

No.2 回答者： keithin 回答日時： 2012/04/21 00:24

方法１）

＞一括してグループ化するコードを教えてください。

「飛び飛びの複数の行」を一括して「グループ化」する事は出来ません。
従ってマクロを使っても、例えば次のようにします。

sub macro1()
　dim w as worksheet
　dim h as range
　on error resume next
　for each w in worksheets
　　w.range("A1").clearoutline
　　for each h in application.intersect(w.usedrange, w.range("C:C")).specialcells(xlcelltypeblanks).areas
　　　h.entirerow.group
　　next
　　w.outline.showlevels rowlevels:=1
　next
end sub

＃補足
既にグループ化処理済みのシートにさらにグループをかけると、レベルが勝手にどんどん深まっていきます。



方法２）
＞他の部門では使わない補助科目が多く、折りたたまないと使い物にならない

「グループ化」じゃなく「折りたためればよい」だけなら、単に行を隠す操作を一括で行うことはできます。

sub macro2()
　dim w as worksheet
　on error resume next
　for each w in worksheets
　　w.range("A1").clearoutline
　　application.intersect(w.usedrange, w.range("C:C")).specialcells(xlcelltypeblanks).entirerow.hidden = true
　next
end sub



＃注意
いずれの方法も、ご質問で言ってる「空白」は「ほんとに空っぽのセル」の意味で、数式等でたとえば「""」が計算されているなどではありません。

この回答への補足

keithin様

早々にご回答頂きましてどうもありがとうございました。
今実行させてみましたところ、グループ化、折りたたみ共に
完璧に動作致しました。
大変助かりました。

ＮＯ１のtom04様も同様の実行結果でしたが、keithinの
実行結果がより高速に動作しました。

なお、厚かましいとは思いますが、条件を追加してみたいの
ですが、ご教授願えればと思います。

１．グループ化対象の開始行を７行目からとする。
２．ブランクの判定対象列をＣ列とＤ列のどちらもブランクで
あった場合のみグループ化する。

もしご覧になりましたら教えて頂ければ大変助かります。

以上、よろしくお願い致します。

補足日時：2012/04/24 14:09

この回答へのお礼

keithin様

質問内容に対して完璧に動作致しました。
どうもありがとうございました。

追加で回答補足として質問してしまいました。

恐縮ですがよろしくお願いしたいと思います。

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

お礼日時：2012/04/24 14:22

No.1 回答者： tom04 回答日時： 2012/04/20 22:41

こんばんは！

一例です。

標準モジュールに↓のコードをコピー＆ペーストしてマクロを実行してみてください。

Sub test()
Dim i, k As Long
For k = 1 To Worksheets.Count
For i = 1 To Worksheets(k).Cells(Rows.Count, 1).End(xlUp).Row
If Worksheets(k).Cells(i, 3) = "" Then
With Worksheets(k).Rows(i)
.Group
.Hidden = True
End With
End If
Next i
Next k
End Sub

こんな感じではどうでしょうか？m(_ _)m

この回答へのお礼

早速ご回答頂きましてどうもありがとうございました。

お返事が遅れてしまい申し訳ありませんでした。
今実行させてみましたところ、依頼通りに動作致しました。
どうもありがとうございました。

お礼日時：2012/04/24 13:51