コードへ追記したら、特定のシートしか実行できません！

質問

Windows XP　Home Edition
Excel　2002

http://oshiete1.goo.ne.jp/qa4952620.html​
以前に、ご教授頂いたコードに少し追記して、しばらく問題なく使用していましたが、
本日、同ブックの他のシートで実行しましたら、無反応で、セルに色が付きません（エラーではありません）。
何度も行ってみましたが同じ結果です。

但し、'★部分「Offset(-1, 0)」の2箇所を削除して実行するとセルに色が付き、問題なく実行できます。

ちなみに、実行できないシートは、1行全部にオートフィルタ（▼）がかかってしまいます。
私は、いつもEntireRowにてオートフィルタ（▼）をかけております。
しかし、10列ぐらいだけにオートフィルタ（▼）をかけて、実行しても結果は、無反応で、セルに色が付きません。

問題なく実行できるシートでは、EntireRowにてオートフィルタ（▼）をかけても、データのある列までしか
オートフィルタ（▼）がかかりません。

このコードは、どんなシートでも実行できると思っていたのですが、
特定のシートでしか実行できないのでしょうか？

原因がわかりません。
よろしくお願い致します。
------------
'SheetModule
Option Explicit

Sub Worksheet_Calculate()

　　Static r As Range
　　Dim f As Filter
　　Dim i As Long

　　On Error GoTo errHndler

　　With ActiveSheet
　　　If .AutoFilterMode Then
　　　　　With .AutoFilter
　　　　　　　　If r Is Nothing Then Set r = .Range.Rows(1)
　　　　　　　　For Each f In .Filters
　　　　　　　　　　i = i + 1

　　　　　　　　　　　　　　　　'★
　　　　　　　　　　r.Cells(i).Offset(-1, 0).Interior.ColorIndex = IIf(f.On, 33, xlNone)
　　　　　　　　'33()が、識別用 ColorIndex。任意で。

　　　　　　　　Next f

　　　　　　End With

　　　　　Else
　　　　　　　　　　　　　　　　　　　　'★
　　　　　　If Not r Is Nothing Then r.Offset(-1, 0).Interior.ColorIndex = xlNone

　　　　　　Set r = Nothing
　　　　　End If
　　End With
errHndler:
　If Err.Number <> 0 Then MsgBox Err.Number & ":" & Err.Description
End Sub

回答No.3

Wendy02 · ベストアンサー

#2の回答者です。

自分のレスを読み直し、元のご質問を読み直してみましたが、読み勘違いがあったかもしれません。ご質問には詳しく書かれていない部分があるようです。

少し、ややこしいので、文章ではうまく伝えられないかもしれませんが、分からなければ、一旦、マクロを試してからお聞きなってください。

-------------------------------------------
(1)
>いつもEntireRowにてオートフィルタ（▼）をかけております。

ひとつの問題は、ここにあります。VBAで行う場合は、通常は、#2で書いたように、Range("A1").CurrentRegion で、範囲を取得するのが一般的です。

つまり、マトリックス（縦横の列）の「左上端のセル」の部分を設定することです。しかし、AutoFilter は、上記では、その「左上端のセル」を、一般的なコードでは探すことが出来ません。ここに人間が介在してあげるのが普通です。

私は、EntireRowではしたことがありません。論理的には可能なはずですが、AutoFilter には、データのある部分を探すという機能が含まれているようですが、何かの作用で取得できないときに、全一行を取得してしまうようです。

誤動作が予想される場合は、Endプロパティで丁寧に、必要な範囲を取得するしかないようです。
*その範囲を取得するコードは、Endプロパティの右から左の方法、左から右への方法など、状況にもよるので、汎用性のあるコードは書けません。

(2)
またコードにある、.Range.Rows(1)のひとつの単位は、Cells(1) ですが、.Offset(-1, 0)
このRange の範囲は、AutoFilter のRange です。もちろん、Offcet(-1,0) で、その上のセルを探すことは可能ですが、それは、物理行の存在がある場合に限るような気がします。エラーが出ないとすると、論理行を指しているかもしれませんが、こちらではエラーが発生します。

訂正：

Sub Worksheet_Calculate()
Static rng As Range
　　Dim i As Long
　　Dim j As Long
　　If ActiveSheet.AutoFilterMode Then
　　　　With ActiveSheet.AutoFilter
　　　　　　If .Range.Rows(1).Row = 1 Then 'タイトル行が1行目の場合
　　　　　　　　j = 0
　　　　　　Else
　　　　　　　　j = -1
　　　　　　End If
　　　　　　For i = 1 To .Range.Rows(1).Cells.Count
　　　　　　　　If .Filters(i).On Then
　　　　　　　　　　.Range.Rows(1).Offset(j, i - 1).Interior.ColorIndex = 33
　　　　　　　　Else
　　　　　　　　　　.Range.Rows(1).Offset(j, i - 1).Interior.ColorIndex = xlNone
　　　　　　　　End If
　　　　　　Next i
　　　　　　Set rng = .Range
　　　　End With
　　Else
　　　　If Not rng Is Nothing Then 'リセット（ただしできないことがある）
　　　　　　rng.Rows(1).Offset(j).Interior.ColorIndex = xlNone
　　　　End If
　　　　Set rng = Nothing
　　End If
End Sub

お礼

こんばんは。
そもそも、私は、基本的な（箇所等への）オートフィルタの掛け方ではなかったようです。
また、Offset(-1, 0)の追記は全くの軽率でした。
でも、御回答のコードは、私のような者へもorどんな箇所へも対応してしまうんですね！！
私の質問内容の不足分まで、先読みし見抜いて頂きまして。
新たなコードを、ご丁寧に、誠に有難うございました。

回答No.2

Wendy02

こんばんは。

元の元は私のコードのようのようですが、だいぶ、違う内容のようです。

これで、On Error Goto errHndler
　r.Cells(i).Offset(-1, 0)

では、最後に飛んでしまいます。
Offset(-1,0) では、セルのないところを選ぼうとしているので、うまくありません。
その場合は、本来は、On Error Resume Next ～ On Error Goto 0 で挟んでやることですが、このようにして出来るのではないかと思います。

また、
>問題なく実行できるシートでは、EntireRowにてオートフィルタ（▼）をかけても、データのある列までしかオートフィルタ（▼）がかかりません。

これは、VBAとはまったく関係のないものです。
任意の範囲にAutoFilter を掛けたいのでしたら、最初に範囲を選択してから、AutoFilter 掛けてください。AutoFilterの自動的な範囲は、VBAとしては、CurrentRegion と同じ意味です。

'-------------------------------------------
'シートモジュール

Sub Worksheet_Calculate()
Static rng As Range
　　Dim i As Long
　　If ActiveSheet.AutoFilterMode Then
　　　　With ActiveSheet.AutoFilter
　　　　　　For i = 1 To .Range.Rows(1).Cells.Count
　　　　　　　　If .Filters(i).On Then
　　　　　　　　　　.Range.Rows(1).Cells(i).Interior.ColorIndex = 33
　　　　　　　　Else
　　　　　　　　　　.Range.Rows(1).Cells(i).Interior.ColorIndex = xlNone
　　　　　　　　End If
　　　　　　Next i
　　　　　　Set rng = .Range
　　　　End With
　　Else
　　　　If Not rng Is Nothing Then
　　　　　　rng.Rows(1).Interior.ColorIndex = xlNone
　　　　End If
　　　　Set rng = Nothing
　　End If
End Sub

回答No.1

hige_082

＞コードへ追記したら、特定のシートしか実行できません！
ご自分でコードを変更したのでは？

解決方法は簡単でしょ
リンク先のコードをコピペすれば解決

＞このコードは、どんなシートでも実行できると思っていたのですが、
＞特定のシートでしか実行できないのでしょうか？
出来ますよ
でも、コードの追加によって、一つ条件が付いてますけどね

＞原因がわかりません。
原因は追加したコードです

以上参考まで

お礼

こんばんは。
＞原因は追加したコードです
おっしゃられるとおりでした。
私の質問コード自体にOffset(-1, 0)の追記は全くの軽率でした。
この追記は、何か変だなと思っていたのですが・・・
ご回答、誠に有難うございました。

補足

早速のご回答、誠に有難うございます。
当方は、Cells(i)の1つ上のセルに実行したいものですから、
現在、いろいろと試しております。
当方にとっては、時間がかかりそうなので、再度、投稿致致します。
申し訳ありません。