マクロで条件付き書式（セルの塗りつぶし）

質問

2003のため、条件付書式を5つ作るのにマクロが必要なのですが触ったことないので全くわかりません。以下のマクロ作ったのですが、"コンパイルエラー　End Subが必要です"と出てしまいます。どこが悪いのか見当も付きません（TT）。添削をお願いします。

やりたいことは、「決まっている範囲内に入力されている単語別にセルの色を分ける」です。

Sub 条件()
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Set rng = IntersectC9: F28

If rng Is Nothing Then Exit Sub
Dim x As Range
For Each x In rng
Dim myColor As Integer
Select Case x.Value
Case "りんご": myColor = 3 '赤色
Case "ばなな": myColor = 45 'オレンジ色
Case "みかん": myColor = 6 '黄色
Case "いちご": myColor = 5 '青色
Case "他": myColor = 4 '緑色
Case Else: myColor = xlNone
End Select
x.Interior.ColorIndex = myColor
Next x
Set rng = Nothing
Set x = Nothing
End Sub

回答No.2

zap35 · ベストアンサー

初めてマクロを書かれた割には惜しいところまできていますが、このマクロでは動きません。

以下のマクロを「シート名右クリック」→「コードの表示」で開く画面に貼り付けてください。ワークシートに戻って C9:F28 に値を入力してみて下さい

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim x As Range
Dim myColor As Integer
　　Set rng = Intersect(Target, Range("C9:F28"))
　　If rng Is Nothing Then Exit Sub
　　For Each x In rng
　　　Select Case x.Value
　　　　Case Is = "りんご"
　　　　　myColor = 3 '赤色
　　　　Case Is = "ばなな"
　　　　　myColor = 45 'オレンジ色
　　　　Case Is = "みかん"
　　　　　myColor = 6 '黄色
　　　　Case Is = "いちご"
　　　　　myColor = 5 '青色
　　　　Case Is = "他"
　　　　　myColor = 4 '緑色
　　　　Case Else
　　　　　myColor = xlNone
　　　End Select
　　　x.Interior.ColorIndex = myColor
　　Next x
End Sub

お礼

うわあああ！できました！！

なんかいろいろ間違ってますね私（＾＾；）勉強になりました。
ありがとうございました！

回答No.1

FEX2053

先頭のこれ

Sub 条件()

を削除すれば動くと思いますが、多分

Set rng = IntersectC9: F28

で止まるでしょうね。ここが何をやりたいか分からないので
なんとも言えないんですが・・・。

お礼

ありがとうございます。

おっしゃるとおり、上記のところおかしかったみたいです＾＾；