VBAの条件分岐を利用したセルの色分け

質問

VBAの条件分岐を使用してセルの色分けをしようとしています。
（条件が5つあり、条件付書式では対応できないためです。）

得点による色分けを行いたいのですが、色分けを行いたいセルに関数（ただ単に「=（イコール）」です）を入れて他のセルを参照する様にしたら、色分けが無効になってしまいました。

例：
【設定した条件】
　0～20点の場合　　赤
　21～40点の場合　 橙
　41～60点の場合　 黄
　61～80点の場合　 緑
　81～100点の場合　青
【現象】
VBAでプログラミング後にセルA1に数値「50」を入力したら、セルの色は「黄」になった。しかし、他のデータシートの値を参照させたいと思い、セルA1に「=データシート!B1」と入力したら、セルの色は消えてしまった。

VBAでセルの色分けをしようとする時は、セルに関数を入力してはいけないのでしょうか？条件付書式の時は問題なさそうなのですが。

お分かりになる方がいらっしゃいましたらお願いいたします。

回答No.4

myRange · ベストアンサー

提示の式では

＞　If Target.Column <> 3 Then Exit Sub

と、Ｃ列に入力されたら、としているわけですから、

＞セルA1に数値「50」を入力したら、セルの色は「黄」になった。

このようになるわけはありえません。
勘違いしてませんか？

ま、これはタイプミスであろうと推測できますから、置いといて。

既出の回答にもあるように、
セルに入れた式の結果で、セルの値が変化したも
Changeイベントは発生しません。
よって、このChangeイベントは、Sheet1ではなくて
参照されているセルのあるSheetのイベントでないといけません。

Sheet1のＡ列（例えば、Ａ１～）に
A1　=Sheet2!B1
A2　=Sheet2!B2
A3　=Sheet2!B3
以下適当な行まで
上記の式が入っているとした場合

Sheet２のＢ列に入力があったら（Sheet2のChangeイベント）
Sheet１のＡ列を塗りつぶす、というコードになります。

よって以下をSheet２にコピペして実行

'-------Sheet２　のchangeイベント ----------------

Private Sub Worksheet_Change(ByVal target As Range)
　Dim myColor As Integer
　If target.Count > 1 Then Exit Sub
　If target.Column <> 2 Then Exit Sub　　'●Ｂ列
　Select Case target.Value
　　　Case 0 To 19
　　　　　myColor = 3 '赤色
　　　Case 20 To 39
　　　　　myColor = 45 'オレンジ色
　　　Case 40 To 59
　　　　　myColor = 6 '黄色
　　　Case 60 To 79
　　　　　myColor = 4 '緑色
　　　Case 80 To 100
　　　　　myColor = 5 '青色
　　　Case Else
　　　　　myColor = xlNone
　End Select

Sheets("Sheet1").Cells(Target.Row, "A").Interior.ColorIndex = myColor

End Sub
'-----------------------------------------------

以上ここまで。

お礼

ありがとうございました。
解決致しました。
的確なご回答に感謝致します。

回答No.3

hana-hana3

＞セルA1に「=データシート!B1」と入力したら、セルの色は消えてしまった。

色が消えたのでは無く、参照先の値が色の設定範囲を超えたので無色に設定されただけでしょう。
１００より大きいかマイナス値。

また、Worksheet_Changeイベントでは該当セルが書き換えられた時に動作するイベントです。
式の参照先の値が書き換わった場合は検知出来ないので、このマクロは動作しません。

お礼

回答頂きましてありがとうございました。

回答No.2

noname#110201

そうですねぇ、No1の方が書かれているように、これでは全然要領を得ません。

ただ、一度黄色になったセルの色が消えるのですから、そのコードはきちんと走っているのだと思います。
セルの色がなくなるか白になる場合があるのではないですか？

補足

すみませんでした。
コードは下記の通りとなります。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myColor As Integer
If Target.Count > 1 Then Exit Sub
If Target.Column <> 3 Then Exit Sub
Select Case Target.Value
Case 0 To 19
myColor = 3 '赤色
Case 20 To 39
myColor = 45 'オレンジ色
Case 40 To 59
myColor = 6 '黄色
Case 60 To 79
myColor = 4 '緑色
Case 80 To 100
myColor = 5 '青色
Case Else
myColor = xlNone
End Select
Target.Interior.ColorIndex = myColor
End Sub

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

回答No.1

hana-hana3

コードくらいは提示しましょう。