アプリ版：「スタンプのみでお礼する」機能のリリースについて

Worksheet_Change 動作しない

解決済

  • 質問者：東西線
  • 質問日時：
  • 回答数：7件

下記のコードで①から③までは実行するのですが、
④⑤が実行致しません。
わかる方おしえてくれませんでしょうか
フォントを追加したせいなのかもしれません。
よろしくお願いいたします。



①Ｅ列　行が　偶数　日付　ならば　フォント　青　でなければ　黒

Private Sub Worksheet_Change(ByVal Target As Range)
With Target

If Not Intersect(Target, Range("E:E")) Is Nothing Then
If .Row Mod 2 = 0 Then
If IsDate(.Value) Then
Cells(.Row, 5).Font.ColorIndex = 5
Else
Cells(.Row, 5).Font.ColorIndex = xlAutomatic
End If
End If

② Ｅ列　行が　奇数　日付　ならば　フォント　赤　でなければ　色なし
　　　　　　　　偶数行のフォントは　青

If Not Intersect(Target, Range("E:E")) Is Nothing Then
If .Row Mod 2 = 1 Then
If IsDate(.Value) Then
Cells(.Row, 5).Font.ColorIndex = 3
Cells(.Row - 1, 5).Font.ColorIndex = 3
Else
Cells(.Row, 5).Font.ColorIndex = xlNone
Cells(.Row - 1, 5).Font.ColorIndex = 5
End If
End If

③　　Ｅ列　行が　奇数　日付　ならば　背景色　奇数行　偶数行　6　でなければ　色なし
　　　　　　　　偶数行のフォントは　青

If Not Intersect(Target, Range("E:E")) Is Nothing Then
If .Row Mod 2 = 1 Then
If IsDate(.Value) Then
Cells(.Row, 5).Interior.ColorIndex = 6
Cells(.Row - 1, 5).Interior.ColorIndex = 6
Cells(.Row, 3).Interior.ColorIndex = 6
Cells(.Row - 1, 3).Interior.ColorIndex = 6
Else
Cells(.Row, 5).Interior.ColorIndex = xlNone
Cells(.Row - 1, 5).Interior.ColorIndex = xlNone
Cells(.Row, 3).Interior.ColorIndex = xlNone
Cells(.Row - 1, 3).Interior.ColorIndex = xlNone
End If
End If


④　Ｆ列　行が　奇数　日付　ならば　背景色　奇数行　偶数行　3　でなければ　色なし
　　　　　　

ElseIf Not Intersect(Target, Range("f:f")) Is Nothing Then
If .Row Mod 2 = 1 Then
If IsDate(.Value) Then
Cells(.Row, 6).Interior.ColorIndex = 3
Cells(.Row - 1, 6).Interior.ColorIndex = 3
Else
Cells(.Row, 6).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 6).Interior.ColorIndex = xlColorIndexNone
End If
End If

ElseIf Not Intersect(Target, Range("h:h")) Is Nothing Then
If .Row Mod 2 = 1 Then
If IsDate(.Value) Then
Cells(.Row, 8).Interior.ColorIndex = 7
Cells(.Row - 1, 8).Interior.ColorIndex = 7
Cells(.Row, 3).Interior.ColorIndex = 7
Cells(.Row - 1, 3).Interior.ColorIndex = 7
Else
Cells(.Row, 8).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 8).Interior.ColorIndex = xlColorIndexNone
Cells(.Row, 3).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 3).Interior.ColorIndex = xlColorIndexNone
End If
End If

⑤
ElseIf Not Intersect(Target, Range("k:k,L:L")) Is Nothing Then

If IsDate(Cells(.Row, 11).Text) And IsDate(Cells(.Row, 12).Text) Then

If Cells(.Row, 11).Value >= Cells(.Row, 12).Value Then
Cells(.Row, 12).Interior.ColorIndex = 3
Else
Cells(.Row, 12).Interior.ColorIndex = xlColorIndexNone
End If
Else
Cells(.Row, 12).Interior.ColorIndex = xlColorIndexNone
End If
End If
End If
End If

End With
End Sub

「Worksheet_Change 動作し」の質問画像

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

  • 申し訳ございません。
    どうしたらいいのか。
    わかりません。

    No.3の回答に寄せられた補足コメントです。 補足日時：2019/09/17 13:21
    通報する

  • うーん・・・

    ④⑤の処理は、最初からの条件分岐でTargetがE列の場合にしか実行されませんので
    ここまではわかりました。
    となると、④⑤にたどりつくには申し訳ございません
    おしえてくれませんでしょうか

    No.2の回答に寄せられた補足コメントです。 補足日時：2019/09/17 13:32
    通報する

  • うーん・・・

    条件分岐で検索　申し訳ございません
    おしえてくれませんでしょうか

    No.1の回答に寄せられた補足コメントです。 補足日時：2019/09/17 13:33
    通報する

  • どう思う？

    ①、②、③の
    If Not Intersect(Target, Range("E:E")) Is Nothing Then
    を①、②、③内で完結させて
    というのは一つにまとめるということですか

    No.4の回答に寄せられた補足コメントです。 補足日時：2019/09/17 17:14
    通報する
通報する

この質問への回答は締め切られました。

質問の本文を隠す

A 回答 (7件)

つらい・・・

No.7ベストアンサー

No.4です。



気まぐれに作ってみた物ですが動作検証が正しいのかは良くわかりませんでした。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim st As String

With Target

st = Left(.Address(0, 0), 1)

Select Case st

Case "E"

If .Row Mod 2 = 0 And IsDate(.Value) Then
Cells(.Row, 5).Font.ColorIndex = 5
Else
Cells(.Row, 5).Font.ColorIndex = xlAutomatic
End If

If .Row Mod 2 = 1 And IsDate(.Value) Then
Cells(.Row, 5).Font.ColorIndex = 3
Cells(.Row - 1, 5).Font.ColorIndex = 3
Cells(.Row, 5).Interior.ColorIndex = 6
Cells(.Row - 1, 5).Interior.ColorIndex = 6
Cells(.Row, 3).Interior.ColorIndex = 6
Cells(.Row - 1, 3).Interior.ColorIndex = 6
Else
Cells(.Row, 5).Font.ColorIndex = xlAutomatic '何故かxlNoneではダメだった。古いからかも。
Cells(.Row - 1, 5).Font.ColorIndex = 5
Cells(.Row, 5).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 5).Interior.ColorIndex = xlColorIndexNone
Cells(.Row, 3).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 3).Interior.ColorIndex = xlColorIndexNone
End If

Case "F"

If .Row Mod 2 = 1 And IsDate(.Value) Then
Cells(.Row, 6).Interior.ColorIndex = 3
Cells(.Row - 1, 6).Interior.ColorIndex = 3
Else
Cells(.Row, 6).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 6).Interior.ColorIndex = xlColorIndexNone
End If

Case "H"

If .Row Mod 2 = 1 And IsDate(.Value) Then
Cells(.Row, 8).Interior.ColorIndex = 7
Cells(.Row - 1, 8).Interior.ColorIndex = 7
Cells(.Row, 3).Interior.ColorIndex = 7
Cells(.Row - 1, 3).Interior.ColorIndex = 7
Else
Cells(.Row, 8).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 8).Interior.ColorIndex = xlColorIndexNone
Cells(.Row, 3).Interior.ColorIndex = xlColorIndexNone
Cells(.Row - 1, 3).Interior.ColorIndex = xlColorIndexNone
End If

Case "K", "L"

If IsDate(Cells(.Row, 11).Text) And IsDate(Cells(.Row, 12).Text) Then
Cells(.Row, 12).Interior.ColorIndex = IIf(Cells(.Row, 11).Value >= Cells(.Row, 12).Value, 3, xlColorIndexNone)
Else
Cells(.Row, 12).Interior.ColorIndex = xlColorIndexNone
End If

End Select

End With
End Sub

たまには検証してみないとＶＢＡ忘れそうですし。
    • good
    • 0
    • 件
通報する
この回答へのお礼

いつも大変お世話になっております。
参りました。
有難うございます。ウレシイ

通報する
お礼日時：2019/09/17 20:22

No.6

  • 回答者： t_fumiaki
  • 回答日時：

>>①、②、③の


>>If Not Intersect(Target, Range("E:E")) Is Nothing Then
>>を①、②、③内で完結させて
>>というのは一つにまとめるということですか

End If
End If
↓
End If
End If
End If

とすれば、完結します。
    • good
    • 0
    • 件
通報する
この回答へのお礼

有難うございます。

通報する
お礼日時：2019/09/17 20:22

No.5

何気に見ていただけですが、②と③って条件同じなので一緒にしても良いように思えますが何か不都合でも？


それとTargetが１つの列しか当てはまらない部分はSelect Case でも良いのでは？って思えました。
    • good
    • 0
    • 件
通報する

No.4

  • 回答者： t_fumiaki
  • 回答日時：

①、②、③の


If Not Intersect(Target, Range("E:E")) Is Nothing Then
を①、②、③内で完結させて

④、⑤のElseIf⇒if に変更する。

[⑤の最後のEnd Ifの個数は見直して下さい]
この回答への補足あり
    • good
    • 0
    • 件
通報する

No.3

  • 回答者： t_fumiaki
  • 回答日時：

①If Not Intersect(Target, Range("E:E")) Is Nothing Then


②If Not Intersect(Target, Range("E:E")) Is Nothing Then
③If Not Intersect(Target, Range("E:E")) Is Nothing Then
④ElseIf Not Intersect(Target, Range("f:f")) Is Nothing Then
④ElseIf Not Intersect(Target, Range("h:h")) Is Nothing Then
⑤ElseIf Not Intersect(Target, Range("k:k,L:L")) Is Nothing Then

③が成立してしまうと、④、⑤には入ってきません。

また、③非成立でも、④のどちらかが成立してしまうと、⑤には入ってきません。
この回答への補足あり
    • good
    • 0
    • 件
通報する
この回答へのお礼

ご丁寧な答え有難うございます。
早速、修正してみます。

通報する
お礼日時：2019/09/17 12:58

参考程度に

No.2

  • 回答者： fujillin
  • 回答日時：

こんにちは



インデントを利用するなどで、条件処理の範囲をきちんと把握できるようにしておけば、間違えは少なくなるものと思います。
ご提示のコードを簡略化すると、

If Not Intersect(Target, Range("E:E")) Is Nothing
'②
　　If Not Intersect(Target, Range("E:E")) Is Nothing
'③
　　　　If Not Intersect(Target, Range("E:E")) Is Nothing
'④
　　　　ElseIf Not Intersect(Target, Range("f:f")) Is Nothing
'⑤
　　　　ElseIf Not Intersect(Target, Range("k:k,L:L")) Is Nothing

　　　　End If
　　End If
End If

という構成になっています。
④⑤の処理は、最初からの条件分岐でTargetがE列の場合にしか実行されませんので、当然ながら条件には合致せず、処理内容が実行されることがないものと考えられます。
なさりたい内容に合わせて、コード化することが必要かと思われます。
この回答への補足あり
    • good
    • 0
    • 件
通報する
この回答へのお礼

ご丁寧な答え有難うございます。
早速、修正してみます。

通報する
お礼日時：2019/09/17 12:58

No.1

  • 回答者： Zincer
  • 回答日時：

以下のような構文となっています。


簡単に言えば
④が③直後のIfのElseIfになっていますが、最初に同条件のTrueの部分に存在するため、Else（＝Fales）とはなり得ないのです。
④⑤に関しては最初のIfのElseIfとしないといけないのではないでしょうか。

If Not Intersect(Target, Range("E:E")) Is Nothing Then
　If .Row Mod 2 = 0 Then
　　・・・・
　End If
② Ｅ列　行が　奇数　日付　ならば　フォント　赤　でなければ　色なし偶数行のフォントは　青
　If Not Intersect(Target, Range("E:E")) Is Nothing Then
③　　Ｅ列　行が　奇数　日付　ならば　背景色　奇数行　偶数行　6　でなければ　色なし偶数行のフォントは　青
　　If Not Intersect(Target, Range("E:E")) Is Nothing Then
　　　If .Row Mod 2 = 1 Then
　・・・・・
　　　End If
④　Ｆ列　行が　奇数　日付　ならば　背景色　奇数行　偶数行　3　でなければ　色なし
　　ElseIf Not Intersect(Target, Range("f:f")) Is Nothing Then
　　　If .Row Mod 2 = 1 Then
　　　・・・・・
　　　End If
　　ElseIf Not Intersect(Target, Range("h:h")) Is Nothing Then
　　　If .Row Mod 2 = 1 Then
　　　　・・・・・
　　　End If
⑤
　　ElseIf Not Intersect(Target, Range("k:k,L:L")) Is Nothing Then
　　　・・・
　　End If
End If
この回答への補足あり
    • good
    • 0
    • 件
通報する
この回答へのお礼

ご丁寧な答え有難うございます。
早速、修正してみます。

通報する
お礼日時：2019/09/17 12:57

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう！

Q質問する（無料）

関連するカテゴリからQ&Aを探す

ページトップページトップ

Q質問する（無料）

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

おすすめ情報