[Excel VB]プルダウンで文字選択、自動的に色を変える

WindowsXP、Excel2003を使っています。

質問内容なのですが、
まず今作成されているエクセルのＢ列に
データ＞入力規則＞設定タブ　入力値の種類を「リスト」
＞元の値　に手打ちで項目が入っています。
（例えば　国語,数学,社会,理科・・）

プルダウンで項目を選択した時に
自動的に設定した色にセルが塗りつぶされるようにしたいです。
プルダウンで選択ではなく、手打ちで「国語」「数学」などと打つと、
あらかじめ設定した色に変わることはできます。

ご教授よろしくお願いいたします。

No.3 回答者： KenKen_SP 回答日時： 2006/11/22 10:43

#2 です。

すみません。以下の部分は嘘です。コードで同じ色に設定されてました。
>　# 失礼ですが、No.1 ご回答で「数学・理科」が同一色になってしまうのは
>　# このためです。

その他のことは本当です。すみませんでした。

No.2 回答者： KenKen_SP 回答日時： 2006/11/22 10:39

こんにちは。

まず、４色までなら条件付き書式を併用すればマクロを使わずに済みます。

国語・算数・理科・社会で４つの要素ですから、これでいけそうですが、
あと一つ、空白時の色が必要なので、計５色が必要ですね...

したがって、マクロで解決するしかありません。

　# 余談ですが、セルの RangeObject.Interior.Color に RGB 関数で色を設定
　# しても、Excel のカラーパレットにある近い RGB 値に勝手に変換されます。
　# つまり、この方法では意図した色に設定できません。

　# 失礼ですが、No.1 ご回答で「数学・理科」が同一色になってしまうのは
　# このためです。

　# 書籍でも Color プロパティーと RGB 関数でセルの背景色を設定できると
　# いったサンプルを見かけますが、これは誤りです。
　# RGB 値により色を設定したい場合は、カラーパレット側を RGB 関数で更新し、
　# ColorIndex でセルの色を指定しなければなりません。

【導入手順】
1.　Excel で目的のシートを選択し、シート選択タブ上で右クリックメニュー
　　[コードの表示]
　　--> Visual Basic Editor（以下 VBE）が起動
2.　VBE の一番大きなスペースに下記のソースコードをコピー＆ペースト
3.　VBE を閉じます
4.　B 列にデータを入力し、動作するか確認して下さい

' 以下ソースコード
' セルの値が更新されたとき起動する（イベントプロシージャ）
Private Sub Worksheet_Change(ByVal Target As Range)

　　' 内容： 値によりセルの背景色を変化させる

　　Dim C As Range
　　On Error Resume Next
　　' ※変化のあったセル＝Target のうち B 列の部分のみに参照しなおす
　　Set Target = Intersect(Target, Columns("B"))
　　' ※の結果 B 列のセルがあるか調べ、無ければ終了
　　If Not Target Is Nothing Then
　　　　Application.ScreenUpdating = False
　　　　' 複数のセルが一度に更新される場合があるので、For ループで
　　　　' セル単位で処理を繰り返す
　　　　For Each C In Target
　　　　　　' セルの値によりセル背景色を決める
　　　　　　Select Case C.Value
　　　　　　　　Case "国語": C.Interior.ColorIndex = 35
　　　　　　　　Case "算数": C.Interior.ColorIndex = 37
　　　　　　　　Case "理科": C.Interior.ColorIndex = 39
　　　　　　　　Case "社会": C.Interior.ColorIndex = 36
　　　　　　　　' その他の値の場合は着色しない
　　　　　　　　Case Else:　 C.Interior.ColorIndex = xlNone
　　　　　　End Select
　　　　Next
　　　　Application.ScreenUpdating = True
　　End If

End Sub

No.1 回答者： Uminchw 回答日時： 2006/11/22 07:52

次のコードでよいと思います

Private Sub Worksheet_Change(ByVal Target As Range)
'Ａ１に入力規則をつける場合です
' ↓
If Target = Range("a1", "a1") Then
Select Case Target.Value
Case "国語"
Target.Interior.Color = RGB(255, 0, 0)
Case "数学"
Target.Interior.Color = RGB(255, 255, 0)
Case "社会"
Target.Interior.Color = RGB(255, 0, 255)
Case "理科"
Target.Interior.Color = RGB(255, 255, 0)
End Select
End If
End Sub