VBAで別の列のセルにも色付け～２

質問

WINDOWS XP EXCELL ２００３です。
いつもお世話になります。

ご迷惑とは重々と承知しながら再度質問させていただきます。

１　御指導を賜りたいのは、
現在A列には月度を示す　０１～１２　が入力され月別にセルの背景色を塗りつぶしていますがこれをA列用のマクロを工夫してF列にも同様に適用したい。
例えば参照図で言うと
A７　０５　ピンク　
A８　０５　ピンク
A９　０６　ライトブルー　
A１０　０７　草色　等のように
※ 参照図のF列のセルには背景色は適用していません。

２　参照図のそれぞれの設定は、　　
※ 計画　と　生産はセル位置だけの違いで生産の方は割愛します。
D１　ユーザー定義　mm/dd
D２　ユーザー定義　２０００００
D３　数値
A７　ユーザー定義　mm

マクロ
ボタン「計画入力」
Sub 計画入力()
Dim GYOU '追加
GYOU = Range("C65536").End(xlUp).Row + 1
Cells(GYOU, 2).Value = Range("D1").Value
Cells(GYOU, 3).Value = Range("D2").Value
Cells(GYOU, 4).Value = Range("D3").Value
End Sub

ボタン「セルセット」
Sub 計画セル()
　　 Range("D1,D2,D3,D1").Select
End Sub
A列のセル塗りつぶし
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 8 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then
Target.Offset(0, 0).Value = Date
End If

Dim c As Integer
If Target.Column <> 2 Then Exit Sub
If Target.Value = "" Then
c = 0
Else
On Error GoTo line
Select Case Month(Target.Value)
Case 1: c = 46
Case 2: c = 4
Case 3: c = 39
Case 4: c = 6
Case 5: c = 7
Case 6: c = 8
Case 7: c = 43
Case 8: c = 3
Case 9: c = 44
Case 10: c = 24
Case 11: c = 40
Case 12: c = 17
End Select
End If
Target.Offset(0, -1).Interior.ColorIndex = c
Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0)
Exit Sub
line:
Target.Offset(0, -1).Interior.ColorIndex = 0
Target.Offset(0, -1).Font.ColorIndex = 0
End Sub

御指導よろしく御願いします。

回答No.1

nattocurry · ベストアンサー

再度質問ということは、前にも質問して、その回答が提示しているコードということでしょうか。
このコードの意味、理解していますか？

理解していれば、

If Target.Column <> 2 Then Exit Sub

を

If Target.Column <> 2 And Target.Column <> 7 Then Exit Sub

に変えるだけだということが容易に解ると思うのですが。

お礼

早速のご回答いただき有難うございました。
悩みに悩んだあげくに旨くいきほんとうに今は至福の一時です。
下記のことが中々分からず本当に済みませんでした。
And Target.Column <> 7 Then Exit Sub

回答No.2

keithin

＞これをA列用のマクロを工夫してF列にも同様に適用したい。

それはあなたが出来なかった「色の選択」とは無関係の部分で，前回・前々回のご質問でも繰り返し回答済みの部分です。
寄せられた回答を丸ごと捨てるのも，そりゃあなたの自由ですが。

再掲：
private sub worksheet_change(byval Target as excel.range)
　dim h as range
　dim a

　a = array(0, 46,4,39,6,7,8,43,3,44,24,40,17)

　set target = application.intersect(target, range("B:B,F:F"))
　if target is nothing then exit sub
　for each h in target
　　h.offset(0, -1).interior.colorindex = a(val(h.offset(0, -1)))
　next
end sub

お礼

本当に知識不足のわたしにお付き合いしていただき有難うございました。
ご迷惑をおかけして誠に申し訳なく思っています。
今後ともこれに懲りず御指導の程よろしく御願いします。

有難うございました。