• 締切済み

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

エクセル2007を使用しています。 次の様なシートで、特定列で条件(ブランク)に一致する行を一括して グループ化するコードを教えてください。      A       B      C       D 1    コード  科目      実績   予算 2   5000  販売収入    100    90 3   5001  受取手数料    4   5002  その他収入 5      【売上高】 100    90 この様な会計の管理帳票で、1シート約800行あり、シートが部門毎に 全部で約100シートが一つのブックに収めてあります。 全部のシートに対して、例えばC列がブランクの行を一括してグループ化 させる様なマクロのコードを教えていただきたいと思います。 (この場合だと3~4行目) 他の部門では使わない補助科目が多く、折りたたまないと使い物に ならないため、現在は手作業で行っております。 どうぞよろしくお願い致します。 

みんなの回答

  • keithin
  • ベストアンサー率66% (5278/7941)
回答No.2

方法1) >一括してグループ化するコードを教えてください。 「飛び飛びの複数の行」を一括して「グループ化」する事は出来ません。 従ってマクロを使っても、例えば次のようにします。 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 #補足 既にグループ化処理済みのシートにさらにグループをかけると、レベルが勝手にどんどん深まっていきます。 方法2) >他の部門では使わない補助科目が多く、折りたたまないと使い物にならない 「グループ化」じゃなく「折りたためればよい」だけなら、単に行を隠す操作を一括で行うことはできます。 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 #注意 いずれの方法も、ご質問で言ってる「空白」は「ほんとに空っぽのセル」の意味で、数式等でたとえば「""」が計算されているなどではありません。

clorver
質問者

お礼

keithin様 質問内容に対して完璧に動作致しました。 どうもありがとうございました。 追加で回答補足として質問してしまいました。 恐縮ですがよろしくお願いしたいと思います。 以上、どうもありがとうございました。

clorver
質問者

補足

keithin様 早々にご回答頂きましてどうもありがとうございました。 今実行させてみましたところ、グループ化、折りたたみ共に 完璧に動作致しました。 大変助かりました。 NO1のtom04様も同様の実行結果でしたが、keithinの 実行結果がより高速に動作しました。 なお、厚かましいとは思いますが、条件を追加してみたいの ですが、ご教授願えればと思います。 1.グループ化対象の開始行を7行目からとする。 2.ブランクの判定対象列をC列とD列のどちらもブランクで あった場合のみグループ化する。 もしご覧になりましたら教えて頂ければ大変助かります。 以上、よろしくお願い致します。

  • tom04
  • ベストアンサー率49% (2537/5117)
回答No.1

こんばんは! 一例です。 標準モジュールに↓のコードをコピー&ペーストしてマクロを実行してみてください。 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

clorver
質問者

お礼

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