エクセルVBA 条件にあうときセルを塗りつぶすには？

質問

エクセルVBA 条件にあうときセルを塗りつぶすには？

エクセルVBAについて教えてください。

_________A 列 _________B 列_________C列_________D列
--------------------------------------------
1行| 基準値_________ 5_____________1____________8
2行| りんご____________1_____________9____________０
3行| みかん___________12___________5____________3
4行| ぶどう____________15___________7____________8
5行| バナナ____________3_____________1____________4

上図のようにデータがあります。
（実物は列行共に膨大です。また条件を４つ以上つける予定なので条件付書式は使えません）

各列の基準値に対して、セルの増減が、０以下のときに黄色に、５から８のとき大きくなるときに赤、９以上のときに青にセルの色を塗りつぶしたいです。
どのようにすればよいでしょうか？

B列の場合、基準値が５です。
B2のセルの場合、基準値５と１（B2セル）の増減は－４です。
増減が０以下のときは黄色に、増減が５から８のときは赤に、増減が９以上のときに青にするので、このときは黄色に塗りつぶします。

B3のセルの場合、基準値５と１２（B３セル）の増減は７です。
増減が５から８のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。

B4のセルの場合、基準値５と１５（B４セル）の増減は１０です。
増減が９以上のとき青色に塗りつぶすので、このセルは青色に塗りつぶします。

C２のセルの場合は、C列の基準値は１（C1セル）です。
基準値１と９（C2のセル）の増減は８です。
増減が５から８のとき赤に塗りつぶすので、このセルは赤に塗りつぶします。

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

回答No.12

hoiho11 · ベストアンサー

すみません　つまらないミスに気づきました

誤）For　Each　C　In　Range（Cells(2,1), Cells( Endclo , Endrow))

正）For　Each　C　In　Range（Cells(2,1), Cells( Endrow , Endcol))

これよく間違えてしまいます

Cells表記は左が行、右が列です

お礼

今日は外出していたので、お礼が遅くなって申し訳ございません。
昨日から大変お世話になり、本当にありがとうございました。
教えて頂いたコードで無事実行することができました。
今回VBAを教えて頂き、VBAを勉強してみようと思いました。
そして、早速VBAの本を買いました。
VBAの本を片手に自分なりにコードを一部変えてみました。

Private Sub SetColor1()

Dim i As Long
Dim Col As Integer
Dim atai As Integer
Dim area As String
Dim keyCells As String
Dim Endrow As Long

'基準値の行を指定
Col = 2
'基準値の下のセルを指定
area = "b3"

Endrow = Range(area).End(xlDown).Row

'塗りつぶし対象となる起点「d3」と塗りつぶし対象末の列「i」を指定
For Each c In Range("d3:i" & Endrow)

atai = c.Value - Cells(Col, c.Column)

If c.Value <> "" Then

Select Case atai

Case Is <= -1
c.Interior.ColorIndex = 6

Case 5 To 8
c.Interior.ColorIndex = 3

Case Is >= 9
c.Interior.ColorIndex = 5

End Select
End If
Next

End Sub

回答No.2

hoiho11

こんな感じ？

これを基本に同じようにC、D列もやってみればよろしい

Sub 色塗り()

Dim c As Range
Dim i As Long
Dim atai As Integer
Dim Endrow As Long

Endrow = Range("a2").End(xlDown).Row

For Each c In Range("a2:a" & Endrow)

atai = c.Offset(0, 1).Value - Range("b1").Value

Select Case atai
Case Is <= 0
c.Offset(0, 1).Interior.ColorIndex = 6

Case 5 To 8
c.Offset(0, 1).Interior.ColorIndex = 3

Case Is >= 9
c.Offset(0, 1).Interior.ColorIndex = 5

End Select

Next

End Sub

補足

この方法だと、エクセルの最終行６５？？？まで黄色に塗りつぶされてしまいます。
また、１列毎しか処理ができないのでしょうか？
指定エリアを１つの関数で処理することはできないのでしょうか？

回答No.1

amondyuru

エクセルのヘルプから、条件付き書式を検索してください。
　やり方も簡単ですがちゃんと説明してあります。

補足

質問にも記入しておりますが、条件を４つ以上つけるので、条件付き書式がつかえません。