入力数値によってセル色が決まるコードで変更が正しく反映されません

質問

セルの入力数値によってセルの塗りつぶし色が決まるコードを自作してみました。
0 =< x < 2 : 赤
2 =< x < 4 : 青
4 =< x < 6 : 黄
6 =< x < 8 : 黄緑
8 =< x < 10: ピンク
それ以外 : 塗りつぶしなし
なんとなくCaseの使い方が正確ではないような気もしますが。。。
ここで困ったことがおきました。手動で数字を入力すると、一応意図したとおりにセルの塗りつぶし色が反映されます。しかし、一旦塗りつぶされたセルの数値を消去しても、塗りつぶしなしとはならずに赤くなってしまいます。
また、対象外のセルから数字を一つコピーして対象セルに貼り付けると、意図したとおりに色が反映されます。しかし、二つ以上のセルをコピーして貼り付けようとすると、実行エラー'13'型が一致しません、というエラーが出てしまいます。
原因が分かりましたらご教示いただけると幸いです。
---
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column >= 1 And Target.Column <= 10 Then
If Target.Row >= 1 And Target.Row <= 10 Then
Select Case Target.Value
Case 0 To 2
Target.Interior.ColorIndex = 3
Case 2 To 4
Target.Interior.ColorIndex = 5
Case 4 To 6
Target.Interior.ColorIndex = 6
Case 6 To 8
Target.Interior.ColorIndex = 4
Case 8 To 10
Target.Interior.ColorIndex = 7
Case Else
Target.Interior.ColorIndex = 2
End Select
End If
End If
End Sub
---

回答No.1

himajin100000 · ベストアンサー

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Object
For Each Cell In Target.Cells

If Cell.Value <> vbNullString Then

If Cell.Column >= 1 And Cell.Column <= 10 Then
If Cell.Row >= 1 And Cell.Row <= 10 Then
Select Case Cell.Value
Case 0 To 2
Cell.Interior.ColorIndex = 3
Case 2 To 4
Cell.Interior.ColorIndex = 5
Case 4 To 6
Cell.Interior.ColorIndex = 6
Case 6 To 8
Cell.Interior.ColorIndex = 4
Case 8 To 10
Cell.Interior.ColorIndex = 7
Case Else
Cell.Interior.ColorIndex = 2
End Select
End If
End If
Else

Target.Interior.ColorIndex = xlColorIndexNone

End If

Next
End Sub

'だとどう？

'参考資料
'http://msdn2.microsoft.com/en-us/library/aa214193(office.11).aspx
'http://www.mrexcel.com/archive2/72800/84449.htm

お礼

さっそくのアドバイスありがとうございました。希望する処理が実行できました。また参考資料として事例満載のサイトのご紹介ありがとうございました。英語は得意ではないのですが、頑張って勉強しようと思います。

回答No.3

redfox63

select Case での値域の設定ですが
case 0 to 2 とすると 0以上2以下といった具合になります

セルに入力されるデータが整数であるなら
case 0 to 1 とした方がいいでしょう

また 何も入力されていないセルは 0と評価されるので
入力されていたセルのデータを削除しても『赤』になるとお思います

コレの回避は
case "" を case 0 to 1 の前に作成した方がいいでしょう

2つ以上のセルを選択して 貼り付けなどを行うと
Changeイベント引数 Targetに変更が生じたセル情報が設定されてくるので
Target.Column や Target.Rowなどがそのままでは値を返せないのでエラーになるのでしょう

この色設定のマクロを Changeイベントの外に追い出して
Changeイベント内は Targetを For Eachループでまわすといった工夫が必要でしょう

たとえば
Sub changeColor(target As Range)
　　If target.Column >= 1 And target.Column <= 10 Then
　　　　If target.Row >= 1 And target.Row <= 10 Then
　　　　　　Select Case target.Value
　　　　　　Case ""
　　　　　　　　target.Interior.ColorIndex = 2
　　　　　　Case 0 To 1.9
　　　　　　　　target.Interior.ColorIndex = 3
　　　　　　Case 2 To 3.9
　　　　　　　　target.Interior.ColorIndex = 5
　　　　　　Case 4 To 5.9
　　　　　　　　target.Interior.ColorIndex = 6
　　　　　　Case 6 To 7.9
　　　　　　　　target.Interior.ColorIndex = 4
　　　　　　Case 8 To 9.9
　　　　　　　　target.Interior.ColorIndex = 7
　　　　　　Case Else
　　　　　　　　target.Interior.ColorIndex = 2
　　　　　　End Select
　　　　End If
　　End If
End Sub

Private Sub Worksheet_Change(ByVal target As Range)
　　Dim r As Range
　　If target.Cells.Count = 1 Then
　　　　changeColor target
　　Else
　　　　For Each r In target
　　　　　　changeColor r
　　　　Next
　　End If
End Sub

といった具合です
# 字下げは全角スペースですのでエラーの場合は置換してください

お礼

さっそくのアドバイスありがとうございました。希望する処理が実行できました。オリジナルコードの分析は大変参考になります。勉強させていただきます。

回答No.2

himajin100000

#1です。

Target.Interior.ColorIndex = xlColorIndexNone

よりも

Cell.Interior.ColorIndex = xlColorIndexNone
の方が自然だなあ