色付き行の非表示について

いつもお世話になっております。
以前こちらで同様の質問が投稿されておりまして、そちらの回答を参考に（原文ほとんどそのままですが・・・）行折りたたみをしていたのですが、
もう少し改良出来るのではないかと思いご相談です。
参考質問は、かなり前に検索をしたので再検索出来なかったのですが・・・

現在、
8行目からデータが入っております。
非表示にしたい行には任意の色で1行全体を色付けしています。
色のついていない行のみ　表示をします。

Sub hidden1()
x = ActiveCell.SpecialCells(xlLastCell).Row
y = ActiveCell.SpecialCells(xlLastCell).Column
For i = x To 8 Step -1
For n = 1 To y
If Cells(i, n).Interior.ColorIndex <> xlNone Then Rows(i).Hidden = True
Next n
Next i
End Sub

こちらですと、すべてのセルを検索し、行の非表示をしていると思います。（VBAの知識が無いので　間違っているかもしれません）
現在データ量は300行程ですので　そんなに時間はかからないのですが、今後1000行、2000行と増えた場合の事を考え改良したいと思いました。
非表示にしたい行のA列には必ず色がついているので
A列を検索し、色がついていればその行を非表示。
というようにする場合　上記どこの文を削れば良いのでしょうか?

出来れば　表示⇔非表示をボタン1個で切り替えられればと思っております。
もし、A列に非表示があれば表示する、
もし、A列に非表示がなければ色付き行を非表示にする
というようなマクロを教えていただければ幸いです。

よろしくお願いいたします。　

No.3 ベストアンサー 回答者： zap35 回答日時： 2008/02/23 15:37

Ａ列に非表示の行があるときは全行表示にして、そうでないときは色つきセルの行を非表示にするマクロサンプルです。

ただし色つきセルは「値が入っている」ことを前提にしていますから、そうでないなら補足してください。

フォームツールバーのコマンドボタンをシートに配置して、右クリック→マクロの登録でマクロを割り当てておけば「表示⇔非表示をボタン1個で切り替え」できます

Sub Macro1()
Dim rng, r As Range
　　Application.ScreenUpdating = False
　　Set rng = Range(Range("A8"), Range("A65536").End(xlUp))
　　If Application.Subtotal(3, rng) = Application.Subtotal(103, rng) Then
　　　　For Each r In rng
　　　　　　If r.Interior.ColorIndex <> xlNone Then
　　　　　　　　r.EntireRow.Hidden = True
　　　　　　End If
　　　　Next r
　　Else
　　　　rng.EntireRow.Hidden = False
　　End If
　　Application.ScreenUpdating = True
End Sub

この回答への補足

PCが不調で　補足が遅れてしまい申し訳ございませんでした。
ご回答、アドバイスありがとうございます。
家で仮で作ったデータでは　表示⇔非表示が出来たのですが
本番のデータベースではエラーになってしまいました・・・
上から1行1行実行してみましたところ
For Each r In rng
の部分で、止まってしまったようです。
（今使用しているPCには本番用bookが入っていないので　確認できないのですが「実行エラー13」と出たと記憶しております・・・）

＞ただし色つきセルは「値が入っている」ことを前提にしていますから・・・
の部分ですが、7行目に色をつけたデータベースのタイトルがあり、所々セル結合しております。
上記の件は関係しているのでしょうか?

大変お手数おかけいたしますがアドバイスよろしくお願いいたします。

補足日時：2008/02/25 19:27

No.5 回答者： zap35 回答日時： 2008/02/28 13:58

＃２です

＞上から3段目　Application.ScreenUpdating = False　の下へ
＞　MsgBox(r.Address)
そこに挿入したらエラーになります。ですから補足していただいたメッセージは意味を持ちません。r.Addressが意味をもつのはFor文以降だからです。

＞3段目から止まってしまっていたようです
3段目ってどの行を指していますか。
　Application.ScreenUpdating = False
で止まる（黄色く反転する）のは考えにくいです。もし
　Set rng = Range(Range("A8"), Range("A65536").End(xlUp))
の行で止まっているなら、実際のシートをコピーしてから、怪しそうな行を１行ずつ削除してステップ実行すればどの行でエラーになったかを特定できると思いますので、それが分かったらエラーコードと共に補足をお願いします。（実際のシートが見えないので、その特定は回答者にはできません）

また、特定作業のときは
　Application.ScreenUpdating = False
はコメントにしておくとよいと思います。そうすると画面描画もされます。

なお今回のマクロで2003,2000の違いはないでしょう。また７行目までは関係ありません。また今度補足するときは「お礼」欄に記入をお願いします。補足欄に書かれると、記入されたことが分かりません。お礼欄ならメールが来るので分かるからです。

この回答へのお礼

アドバイスありがとうございます。
会社PCで検証用として、本番用と同様のシートを作りマクロを動かしてみましたがやはりエラーになってしまいました。
その検証用シートを　家PCへ転送し、家PCでマクロを動かしてみたところ　きちんと行表示⇔非表示が出来ましたので
会社のPCが　良くなかったようです・・・

色々　アドバイス、ご尽力くださりありがとうございました。
PCの環境で出来なく残念でしたが　勉強になりました!!

お礼日時：2008/03/01 09:49

No.4 回答者： zap35 回答日時： 2008/02/25 20:23

＃０３です

Error(13)は「型が一致しません」です。

結合セルがあるときマクロが意図しない動作をすることはよくあるのですが、今回のマクロは代入は基本的に行っていないのでなぜエラーになったか悩んでいます。少なくとも７行目のタイトルは関係なさそうです。

試しに
・A列とB列のセルをを結合
・A列の複数のセルを結合
・A列からC列まで、複数の行を結合
・A列は結合せず、B列とC列を結合
してみて、掲載したマクロを動かしてみましたが正常に動作しました。

ステップ実行をご存じのようですので
　For Each r In rng
の下に
　　MsgBox(r.Address)
を書き加えて、どのセルまでは正しく処理しているか、どのセルでエラーになったのかをみれば、どんな条件の時にエラーになったか分かると思います。どんなパターンがNGか分かったら教えてください

なお念のため確認ですがロジックは何か追加されていませんか？
追加ロジックが影響しているとなると、お手上げです。

この回答への補足

アドバイスありがとうございます。
申し訳ございません。
はじめの私の調べ方が悪く、エラー箇所の訂正です。
3段目から止まってしまっていたようです。
上から3段目　Application.ScreenUpdating = False　の下へ
　MsgBox(r.Address)
へ書き加えたところ、
「実行時エラー91　オブジェクト変数またはWithブロック変数が設定されていません」と出ました。

お教えいただいたもの以外は書き加えていないです。

ちなみに、家のPCで作ったテスト用エクセルはエクセル2003、
本番用エクセルはエクセル2000です。この辺は関係しているのでしょうか?

本番用シートは、
A列1～6まで空欄色設定無し、7にタイトル、8から数字のみのデータ（00001、00002等）に色設定があったりなかったりとなっております。
B以降は、データの入力があったりなかったりのセルで、所々列の非表示をしております。
（列を全部表示した状態でもエラーが出てしまったので関係ないと思いますが・・・）

うまく説明出来ず申し訳ございません。

補足日時：2008/02/27 06:55

No.2 回答者： YSNR-HRN 回答日時： 2008/02/23 12:37

A列のみチェックします。

Sub hidden1()
x = ActiveCell.SpecialCells(xlLastCell).Row
'y = ActiveCell.SpecialCells(xlLastCell).Column　削除
For i = x To 8 Step -1
'For n = 1 To y　削除
If Cells(i, 1).Interior.ColorIndex <> xlNone Then Rows(i).Hidden = True '　変更　n→1
'Next n　削除
Next i
End Sub

この回答へのお礼

PCが不調で　お礼が遅れてしまい申し訳ございませんでした。
ご回答、アドバイスありがとうございます。
どの部分を削り、変更すれば良いのか教えていただき　勉強になりました。
自分なりに色々削ったりしたのですが　エラーになっていたので助かりました。

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

お礼日時：2008/02/25 19:21

No.1 回答者： okormazd 回答日時： 2008/02/23 11:05

行1まで検索するようにした。

Sub hidden1()

x = ActiveCell.SpecialCells(xlLastCell).Row
n = 1
For i = x To 1 Step -1
'For n = 1 To y
If Cells(i, n).Interior.ColorIndex <> xlNone Then Rows(i).Hidden = True
'Next n
Next i

End Sub

この回答へのお礼

PCが不調で　お礼が遅れてしまい申し訳ございませんでした。
ご回答、アドバイスありがとうございます。
無事色付き行、非表示にすることが出来ました!

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

お礼日時：2008/02/25 19:20