このコードですが、うまく実行できません！

質問

EXEL 2002　です。
最終シートに　「約40行」　ぐらいのデータがあり、
　　その各行の列に、　約20個の数値のセルがあり、
　　　その各セルの数値が　3　以上だったら、　「.Offset(38, 0)」セルを赤色にする。
を、全部の　「約40行」　に実行したいと思っております。

下記コードなのですが、　うまくできません、　3行目がエラーとなります。
何卒、ご教示よろしくお願い致します。
-------------------------
Sub 数値3以上なら上方セルを赤色にする()
Dim r As Range
With Worksheets(Worksheets.Count)
For Each r In .Range("A40", .Range("A65536").End(xlUp))
If r.Offset(0, 1).Resize(, r.Offset(0, 1).Range("IV40").End(xlToLeft)).Cells.Value >= 3 Then
r.Offset(38, 0).FormatConditions(1).Interior.ColorIndex = 3 '赤に塗りつぶす

End If
Next r
End With
End Sub

回答No.2

popesyu · ベストアンサー

補足を読みましたがますますもって意味が不明になっています。
1で示したサンプルの範囲（E65536）、offcetの数字を適当に変えるだけでよいのに、なぜさらにCallで呼び出してForEachで二重化しようと考えられたのかが分かりません。
根本的にForEach内でどのような動作がされているのかが理解されていないようですので、デバッグモードで一行ずつ処理を目で追ってみたらどうでしょう。
もっと単純にして説明すると、
下記のコードだと
For Each r In Range("A1", "E2")
r.Value = r.Address
Next r
1週目はA1のセルに"A1"が入力され、2週目はB1のセルに"B1"、3週目は...と最後のE2までループされます。
まずここの動作を理解したうえで、その次のステップに進みましょう。
1.値を比較する（IF文）、色を変える(ColorIndex)
2.範囲を動的に指定する（End(xlUp)）、セルを塗り替える場所を相対的に指定する（offcet）

ただしそれ以前に特定セルの値の条件によって、どこかのセルの色を変えるだけなら、条件付書式を使えばよいと思うのですが、それではダメなんでしょうか？　簡単にできることを敢えて難しくやる必要はないでしょう。

お礼

どうも有難うございました。
1行ごとにしか、実行されないものと思っておりました。
大変、申し訳ございませんでした。

回答No.1

popesyu

どこがおかしいかは一発で分かりましたが（●の部分が抜けている）、
If r.Offset(0, 1).Resize(●, r.Offset(0, 1).Range("IV40").End(xlToLeft)).Cells.Value >= 3 Then
構文自体が成立していないため、適当な数値を入れたところで動かないかと思います。

意図は何となく理解できないこともないですが、ForEachで個別にRangeを取り出しておいて、resizeをするのがおかしいですし（そもそも値の比較は個々のセルと特定の値同士でないと成立しません）、offsetの使い方もおそらく一つずつ順番に比較するというようなことを意図しているのではと想像しますが、それはFor Eachの方で指定します。

もの凄く単純に、A1～E？までの各セルの値が3以上なら10個下のセルを赤にするだけなら下記のような感じになります。これを修正すれば意図に近いものができそうな気もします。
-----
With Worksheets(Worksheets.Count)
For Each r In .Range("A1", .Range("E65536").End(xlUp))
If r.Cells.Value >= 3 Then
r.Offset(10, 0).Interior.ColorIndex = 3 '赤に塗りつぶす
End If
Next r
End With
-----
ただしこの程度のことなら条件付書式だけでかまわないような気がします。

補足

ご回答、誠に有難うございます。
よく解りませんが、下記（正常に動作しません）のように、Call　すればよいのでしょうか？
つなげかたも、うまくできません。
よろしくお願い致します。

Sub 数値3以上なら下方セルを赤色にする()
Dim r As Range
　　With Worksheets(Worksheets.Count)
　　For Each r In .Range("A40", .Range("A65536").End(xlUp))
　　　Call 赤に塗りつぶす
　　Next r
　　End With
End Sub
'-------------
Sub 赤に塗りつぶす()
Dim r As Range
　For Each r In Worksheets(Worksheets.Count).Range(Selection, Selection.Offset(0, 8))
　　If r.Value >= 3 Then
　　　r.Offset(38, 0).Interior.ColorIndex = 3 '赤に塗りつぶす
　　End If
　Next r
End Sub