エクセル2003で、数式で出されたセルの値によって、そのセル自体を塗り

質問

エクセル2003で、数式で出されたセルの値によって、そのセル自体を塗り分けしたいのですが、７種類あるため条件付書式では対応出来ず困っています。

具体的には「２．７０００～２．７０９９」ならピンク、「２．７１００～２．７１９９」なら黄色、「２．７２００～２．７２９９」なら黄色「２．７３００～２．７３９９」なら緑色「２．７４００～２．７４９９」なら青色「２．７５００～２．７５９９」なら紫「２．７６００～２．７６９９」なら灰色
という具合です

漠然としていて申し訳ないのですが、マクロを使用したいと思っています。お力を貸していただけないでしょうか？

回答No.2

keithin · ベストアンサー

＞数式で出されたセルの値によって、そのセル自体を塗り分けしたい

マクロに精通しているともっと高速なマクロにチューニングできますが，今の丸投げの様子では無理そうなので，とりあえず「Ａ列にある数式セル」を毎回色を塗ります。

手順：
シート名タブを右クリック，コードの表示を選ぶ
現れたシートに下記をコピー貼り付ける

Private Sub Worksheet_Calculate()
　Dim h As Range
　Dim c

　’色を塗るセル範囲を変更するのはここ
　For Each h In Range("A:A").SpecialCells(xlCellTypeFormulas)

　Select Case h.Value
　Case Is < 2.7
　　c = xlNone
　Case Is < 2.71
　　'「２．７０００～２．７０９９」ならピンク、
　　c = 7
　Case Is < 2.72
　　'「２．７１００～２．７１９９」なら黄色、
　　c = 6
　Case Is < 2.73
　　'「２．７２００～２．７２９９」なら黄色
　　c = 6
　Case Is < 2.74
　　'「２．７３００～２．７３９９」なら緑色
　　c = 10
　Case Is < 2.75
　　'「２．７４００～２．７４９９」なら青色
　　c = 5
　Case Is < 2.76
　　'「２．７５００～２．７５９９」なら紫
　　c = 13
　Case Is < 2.77
　　'「２．７６００～２．７６９９」なら灰色
　　c = 15
　Case Else
　　c = xlNone
　End Select

　h.Interior.ColorIndex = c
　Next

End Sub

ファイルメニューから終了してエクセルに戻る。
再計算が走る都度，Ａ列を塗り替える。

＃塗りたい色のご説明が変だったりしますので，またもうちょい違う色にしたい時も，下記のURLを参考に自力で色の番号（ｃ＝５とかの所）を直してみてください。
あといわずもがなですが，ご相談の状況では通常よく使われるchangeイベントのマクロは，そのままでは使えません。（高速なマクロにチューニングする時には使いますが）

参考URL：

http://furyu.tea-nifty.com/annex/2006/05/excel_cab9.html

お礼

どなたの回答も非常に分かりやすく助かりましたので、先に回答された順でベストを選ばせていただきます。ありがとうございました。。

回答No.5

tom04

こんばんは！
すでに色々回答は出ていますので、
参考程度で・・・

色をつけたいセルを範囲指定した後に実行します。

Sub test()
Dim c As Range
For Each c In Selection
Select Case c.Value
Case Is < 2.7: c.Interior.ColorIndex = 0
Case Is < 2.71: c.Interior.ColorIndex = 7
Case Is < 2.72: c.Interior.ColorIndex = 36
Case Is < 2.73: c.Interior.ColorIndex = 6
Case Is < 2.74: c.Interior.ColorIndex = 10
Case Is < 2.75: c.Interior.ColorIndex = 5
Case Is < 2.76: c.Interior.ColorIndex = 13
Case Is < 2.77: c.Interior.ColorIndex = 16
End Select
Next c

End Sub

カラーインデックスは↓のURLが参考になると思います。

http://homepage2.nifty.com/vbasys/vbasys/vbaUtility/colorindex.htm

回答No.4

kmetu

たとえば　以下のような感じでしょうか
入力した行と同じ行のD列に計算結果が入るとして(D列自体にデータを入力しても同じ)D列の色を変えます。

Private Sub Worksheet_Change(ByVal Target As Range)

With Range("D" & Target.Row)

Select Case .Value

Case 2.7 To 2.7099
.Interior.ColorIndex = 7
.Interior.Pattern = xlSolid

Case 2.71 To 2.7199
.Interior.ColorIndex = 6
.Interior.Pattern = xlSolid

End Select

End With

End Sub

回答No.3

xls88

解決したのではないのですか？

こんな感じでどうでしょうか。
対象セル範囲は実際に合わせて書き直してください。
ColorIndex値は適当にしていますからご自分で調べてください。
セルの塗り潰しをマクロの記録すれば得られます。

Private Sub Worksheet_Calculate()
Dim rng As Range
Dim c As Range
Dim idx As Variant

Set rng = Range("B2:B11")
For Each c In rng
Select Case c.Value
Case Is <= 2.6099: idx = 0
Case Is <= 2.7099: idx = 3
Case Is <= 2.7199: idx = 4
Case Is <= 2.7299: idx = 5
Case Is <= 2.7399: idx = 6
Case Is <= 2.7499: idx = 7
Case Is <= 2.7599: idx = 8
Case Is <= 2.7699: idx = 9
Case Else: idx = 0
End Select
c.Interior.ColorIndex = idx
Next
End Sub

お礼

以前助けていただいた方でしょうか。値の導き方で不具合が生じてしまい更に変更が必要になってしまったので、再度質問させていただきました。ありがとうございました

回答No.1

noname#145943

http://oshiete1.nifty.com/qa4425508.html
でしょうか。