マクロ 色の設定

質問

特定の文字を入れると選択したセルが塗りつぶされるようにしたく思い、
ネットで検索して、できることはできたのですが、
自分の好きな色に変更する方法が分かりません。

当方、マクロに関しては全くの初心者です。

どこをどのように変えればよいのか教えて下さい。

Private Sub Worksheet_Change(ByVal Target As Range)

If Range("B22").Value = "アポ" Then
Range("B22:J22").Interior.Color = vbRed
Else
Range("B22:J22").Interior.ColorIndex = xlColorIndexNone
End If

End Sub

B22のセルに「アポ」と入るとＢ22～J22が赤色に、なるというマクロです。
多分、「vbRed」というのを変えればいいとは分かるのですが、どうしてよいのやら…

自分としては、添付した画像のように、左側の文字によって、隣のセルが
ピンク、オレンジ、水色、黄色（自分で作った色かと思います）に
なるようにしたいのです。

回答No.4

don9don9 · ベストアンサー

参考URLのサイトに、色見本とコード例があります。

下の方のコード例（複数セルが一度に変更された場合）を
私の方で改変してみましたので、お試し下さい。

B列の値が変更された場合に、B列の値に応じて
B列～J列に色をつけるコードになります。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myColor As Variant
Dim c As Range
Dim myRng As Range
Set myRng = Application.Intersect(Range("B:B"), Target)
If myRng Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each c In myRng
Select Case c.Value
Case "アポ"
myColor = 3 '赤
Case "予約"
myColor = 7 'ピンク
Case "待ち"
myColor = 46 'オレンジ
Case "承認"
myColor = 8 '水色
Case "請求"
myColor = 6 '黄色
Case Else
myColor = xlNone
End Select
Cells(c.Row, 2).Resize(1, 9).Interior.ColorIndex = myColor
Next c
Application.EnableEvents = True
End Sub

参考URL：

http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_cell_color.html

お礼

回答ありがとうございます。
他の方々からも貴重なご回答を頂きましたが
こちらの方のが、成功しました。
また、質問することがありましたら、
よろしくお願い致します。

回答No.6

tom04

No.5です！
たびたびごめんなさい。
前回のコードではB列の内容に変更があった場合に対応できないと思いますので、
↓のように変更してみてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Cells.Interior.ColorIndex = xlNone
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
For i = 17 To ws1.Cells(Rows.Count, 2).End(xlUp).Row
For j = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 2) = ws2.Cells(j, 1) Then
ws1.Range(Cells(i, 2), Cells(i, 10)).Interior.Color = _
ws2.Cells(j, 2).Interior.Color
End If
Next j
Next i
End Sub

どうも何度も失礼しました。m(__)m

お礼

2回も回答ありがとうございます。
参考にさせて頂きました。
他のシートでやってみたのですが、ちょっと私には
出来なかったみたいです。多分シート名がおかしいのかしら？

まだまだ、勉強することは多そうです。
早く仕事で「勝ち」、会社での私の「価値」を高めたいです。
また、質問することがありましたら、どうぞよろしく
お願い致します。

回答No.5

tom04

こんばんは！
一例です。

↓の画像のようにSheet2に色見本としてB列に表示したい色で塗りつぶししておきます。

そして画面の左下にあるSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面が出ますので
↓のコードをコピー＆ペーストしてみてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column <> 2 Then Exit Sub
Dim i, j As Long
Dim ws1, ws2 As Worksheet
Set ws1 = Worksheets("sheet1")
Set ws2 = Worksheets("sheet2")
For i = 17 To ws1.Cells(Rows.Count, 2).End(xlUp).Row
For j = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
If ws1.Cells(i, 2) = ws2.Cells(j, 1) Then
ws1.Range(Cells(i, 2), Cells(i, 10)).Interior.Color = _
ws2.Cells(j, 2).Interior.Color
End If
Next j
Next i
End Sub

これでB列に文字を入力するたびB列～J列の色が表示されると思います。
尚、色を変更したい場合はSheet2のB列の色を変更すればSheet1に反映されるはずです。

以上、参考になれば良いのですが・・・m(__)m

お礼

わざわざ、データを作成していただいてありがとうございます。
見やすくて分かりやすかったです。

回答No.3

merlionXX

すみません、ANo2です。
あやまったコードを張ってしまいました。
修正しました。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim myC As Range
　　Dim c As Long
　　If Target.Column = 2 Then
　　　　For Each myC In Intersect(Target, Columns("B:B"), Me.UsedRange)
　　　　　　Select Case myC.Value
　　　　　　　　Case "アポ": c = 7
　　　　　　　　Case "予約": c = 46
　　　　　　　　Case "待ち": c = 8
　　　　　　　　Case "承認": c = 6
　　　　　　　　Case "請求": c = 35
　　　　　　　　Case Else: c = xlNone
　　　　　　End Select
　　　　　　myC.Resize(, 9).Interior.ColorIndex = c
　　　　Next
　　End If
End Sub

回答No.2

merlionXX

こんな感じでしょうか？
B列に入力された文字列に反応します。
使用したColorIndexプロパティ値については以下のサイトをご参考に。
http://www.relief.jp/itnote/xls_colorindex.php

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim c As Long
　　If Target.Column = 2 Then
　　　　Select Case Target.Value
　　　　　　Case "アポ": c = 7
　　　　　　Case "予約": c = 46
　　　　　　Case "待ち": c = 8
　　　　　　Case "承認": c = 6
　　　　　　Case "請求": c = 35
　　　　　　Case Else: c = xlNone
　　　　End Select
　　　　Target.Resize(, 9).Interior.ColorIndex = c
　　End If
Exit Sub

お礼

ご回答ありがとうございます。
皆さま、回答が早くてびっくりです。
参考にさせて頂きました。

回答No.1

shigenobi

こんにちは。

vbRedというのは、VBAの定数です。
http://www.red.oit-net.jp/tatsuya/vb/fixed.htm

それ以外に色をつけたい場合、色を表現するRGB値で指定させてあげたらできますよ。
http://www.excellenceweb.net/vba/object/range_member/interior/color.html
http://www.scollabo.com/banban/lectur/websafe.html

お礼

ご回答ありがとうございます。
参考になりました。