複数処理 Worksheet_Change(ByVal Target As Range)

下記のこーどを実行すると
上のコードだけ実行されます。
どこをなおしらよいのか。
わかる方おしえてくれませんでしょうか
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("E:E,G:G")) Is Nothing Or Target.Count > 1 Then Exit Sub
With Target
If .Row Mod 2 = 0 Then
If IsDate(.Value) Then
Cells(.Row, "A").Interior.ColorIndex = 6
End If
End If
End With



Dim rw As Long
If Target.Column <> 2 And Target.Column <> 3 Then Exit Sub
rw = Target.Row
If IsDate(Cells(rw, 2).Text) And IsDate(Cells(rw, 3).Text) Then
If Cells(rw, 2).Value >= Cells(rw, 3).Value Then
Cells(rw, 1).Interior.ColorIndex = 3
Else
Cells(rw, 1).Interior.ColorIndex = 1
End If
Else
Cells(rw, 1).Interior.ColorIndex = xlColorIndexNone
End If

End Sub

質問者からの補足コメント

• 

  Application.EnableEvents = False
  Application.EnableEvents = True
  をつけるとしたらどの場所がよいのでしょぅか。
  もしくは必要ないのでしょぅか。
  おしえてくれませんでしょうか

  No.1の回答に寄せられた補足コメントです。 補足日時：2019/06/15 22:25

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2019/06/15 21:40

そのコードは、二人の人物が書いたもののようですから、なるべく書法は合わせるようにしてみました。

内容については未検証です。

Private Sub Worksheet_Change(ByVal Target As Range)
　With Target
　　If .Count > 1 Then Exit Sub
　　If Not Intersect(Target, Range("E:E,G:G")) Is Nothing Then
　　　If .Row Mod 2 = 0 Then
　　　　If IsDate(.Value) Then
　　　　　Cells(.Row, 1).Interior.ColorIndex = 6
　　　　End If
　　　End If
　　ElseIf Not Intersect(Target, Range("B:C")) Is Nothing Then
　　　If IsDate(Cells(.Row, 2).Text) And IsDate(Cells(.Row, 3).Text) Then
　　　　If Cells(.Row, 2).Value >= Cells(.Row, 3).Value Then
　　　　　Cells(.Row, 1).Interior.ColorIndex = 3
　　　　Else
　　　　　Cells(.Row, 1).Interior.ColorIndex = 1
　　　　End If
　　　Else
　　　　Cells(.Row, 1).Interior.ColorIndex = xlColorIndexNone
　　　End If
　　End If
　End With
End Sub

この回答へのお礼

お忙しい有難うございます。
完璧です。
本当にありがとうございました

お礼日時：2019/06/15 22:44

No.3 回答者： tom04 回答日時： 2019/06/15 22:13

No.2です。

投稿後気づきました。
A列の「色なし」が抜けていました。

＞Cells(.Row, "A").Interior.ColorIndex = 1
＞End If
の次に
＞Else
＞Cells(.Row, "A").Interior.ColorIndex = xlNone
の2行を追加してください。

どうも失礼しました。m(_ _)m

この回答へのお礼

有難うございます。

お礼日時：2019/06/15 22:22

No.2 回答者： tom04 回答日時： 2019/06/15 21:43

こんばんは！

＞If Intersect(Target, Range("E:E,G:G")) Is Nothing Or Target.Count > 1 Then Exit Sub
の1行でE・G列以外はチェンジイベントを発生させないようにしているので、
ここでB・C列も加える必要があります。

Private Sub Worksheet_Change(ByVal Target As Range)
　If Intersect(Target, Range("B:C,E:E,G:G")) Is Nothing Or Target.Count > 1 Then Exit Sub
　　With Target
　　　If .Column > 3 Then
　　　　If .Row Mod 2 = 0 Then
　　　　　If IsDate(.Value) Then
　　　　　　Cells(.Row, "A").Interior.ColorIndex = 6
　　　　　End If
　　　　End If
　　　Else
　　　　If IsDate(Cells(.Row, "B")) And IsDate(Cells(.Row, "C")) Then
　　　　　If Cells(.Row, "B") >= Cells(.Row, "C") Then
　　　　　　Cells(.Row, "A").Interior.ColorIndex = 3
　　　　　Else
　　　　　　Cells(.Row, "A").Interior.ColorIndex = 1
　　　　　End If
　　　　End If
　　　End If
　　End With
End Sub

こんな感じでしょうかね。


※　お示しのコードをそのまま生かしたのですが、気になる点がいくつかあります。

①　B・C列に関しては偶数行ではなく、すべての行が対象になります。
②　B・C列とE・G列の優先順位はないのでしょうか？
上記コードだと最後に変更した列が対象になりますので、
仮にA列が黄色に色付けされていても、B・C列の入力の方が後だと
そちらの条件の色付けとなります。m(_ _)m

この回答へのお礼

有難うございます。

お礼日時：2019/06/15 22:22