VBAでセルの色付を別の列にも追加するには

質問

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

現在下記の如く、
A列にマクロを設定しています。

※A F列には下記の数式が入っています。
A2 =IF(B2="","",TEXT(B2,"mm"))
F2 =IF(G2="","",TEXT(G2,"mm"))

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then
Target.Offset(0, -1).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

上記のマクロに追加でF列にも同様にセルの色付けするにはどうすればいいか
ご教授を御願いできないでしょうか。

回答No.1

keithin · ベストアンサー

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then
Target.Offset(0, -1).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, +4).Interior.ColorIndex = c
Target.Offset(0, -1).Font.ColorIndex = IIf(c = 1, 2, 0)
Target.Offset(0, +4).Font.ColorIndex = IIf(c = 1, 2, 0)
Exit Sub
line:
Target.Offset(0, -1).Interior.ColorIndex = 0
Target.Offset(0, +4).Interior.ColorIndex = 0
Target.Offset(0, -1).Font.ColorIndex = 0
Target.Offset(0, +4).Font.ColorIndex = 0
End Sub

Ａ列に行ったのと全く同じ事をＦ列にも行うだけです。

補足

早速ご回答を有難うございました。

御指導いただいたマクロでテストした結果、
B２　に 1/1 と入力したところA2セルには確かにセルに色づけはされました。
ただしF２まで色付けれてしまいました。
F２はA２とは場合により別の値になります。　月初、月末時です。
誠に恐れ入りますが再度御指導願えませんでしょうか。
よろしく御願いします。

回答No.2

keithin

。。。。。

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "C").End(xlUp).Address Then
Target.Offset(0, -1).Value = Date
End If
If Target.Row >= 2 And Target.Address = Cells(Rows.Count, "G").End(xlUp).Address Then
Target.Offset(0, -1).Value = Date
End If

Dim c As Integer
If Target.Column <> 2 and target.column <> 7 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

まだダメなら，いったい「何列でどうしたら何列をどうしたい」のかといった具合を，キチンと漏れなく説明を補足してください。

お礼

回答をいただきながらお礼が遅くなりました。

なんとか解決しました。
#２で回答いただいてテストしました。
G列に入力するとF列には色は付くんですが今日の日付が出ます。
なぜか原因が分からす調べて今になりました。

F列を　ユーザー定義で　mm/dd　にしていたのを標準したらうまくできました。

知識不足で迷惑掛けます。
有難うございました。