エクセル：Worksheet_Changeイベントについて

質問

Private Sub Worksheet_Change(ByVal Target As Range)
　　If Target.Column = 4 Then
　　　　Target.Offset(0, 1).ClearContents
　　　　Target.Offset(0, 2).ClearContents

　　ElseIf Target.Column = 5 Then
　　　　Target.Offset(0, 1).ClearContents
　　　　Target.Offset(0, -1).ClearContents

　　ElseIf Target.Column = 6 Then
　　　　Target.Offset(0, -1).ClearContents
　　　　Target.Offset(0, -2).ClearContents

　　ElseIf Target.Column > 6 Then
　　　　Target.Offset(0, 4 - Target.Column).ClearContents
　　　　Target.Offset(0, 5 - Target.Column).ClearContents
　　　　Target.Offset(0, 6 - Target.Column).ClearContents

　　End If

End Sub

D列に値が入ればE,F列の値を削除、E列に値が入ればD,F列の値を削除、
F列に値が入ればD,E列の値を削除、G列以降に値が入ればD,E,F列の値を削除、
というマクロを組みたいです。
先日似たような件で質問し、上記のコードを作りました。
１つのセルに値を入力する場合は問題無いのですが、
範囲指定の右下(黒十字が出る)をマウスでドラッグで引っ張る、もしくは、範囲指定した部分をドラッグして移動、
という操作をすると、値がついてくる時とそうでない時があります。
数字の大きいセル番地だと何故かそのような現象が出ません。
どういった理由からで、どのように修正すればよいでしょうか。

回答No.4

KenKen_SP · ベストアンサー

> これは別の操作によるエラーの抑止になっていたりするのでしょうか？

例えば、ユーザーが D1:F5 セルにデータをコピペした場合は、
D～F列にそれぞれデータが入力されるわけですが、この場合の
処理方法が不明だったからです。

単純にそれだけの理由なので、

> If Target.Columns.Count > 1 Then Exit Sub

を取り除いた方が、ご希望に沿った動作なのであれば、無く
ても構わないと思います。

回答No.5

papayuka

#2です。

> Application.EnableEvents　って最初と最後だけでよかったのですね。

素人なので正しい書き方か解りません。
実行中に Change が再帰的に呼ばれなければ良いだけなのでそうしてます。
一応動いてるし、、、

---

私の例ではD1:F5 セルにデータをコピペした場合は何も残らないですね。
その変わり、D1とE2とF3 のように飛び飛びにセルを選んで、Ctrl+Enterで同じ値を入力した場合でも動作すると思います。

複数列に対して処理があるなら、用途によってでしょうか、、、

回答No.3

imogasi

自身の無いところだが、
＋ハンドルを引っ張って、値を複写したり、設定したとき
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Xi As Long
For X = 1 To Target.Count
MsgBox Target(X).Value & " " & Target(X).Address
Next X
End Sub
で順次セル値やセルアドレスが捉えられるようです。
Target(X).Value と Target(X).Address　やTarget(X).Columnなどを
使って判別などして、
上記のMsgBoxのところへ質問の処理を入れたらどうでしょう。
ーー
それにしても質問のコードは、Ｃａｓｅ文ででも使って誠意して書き直しては。
またTarget.Offset(0, 1).ClearContents
はCells(Target.Row,"E").ClearContents
とできるだけ明示したほうが好き。

お礼

回答ありがとうございます。

>＋ハンドルを引っ張って、値を複写したり、設定したとき
非常に参考になります。
確かに１つずつMsgBoxに表示されていますね。

>Cells(Target.Row,"E").ClearContents　とできるだけ明示したほうが好き。
同感です。
最初はOffsetなど使わずにCellsで指定していたのですが、
offsetで指定しないと前述した「＋ハンドルを引っ張って」の時に一番上のセルにしか反応しなかったので、
自分でセルの位置を数えたりしてoffsetに切り替えました。
当時のコードではD,E,F列に限り、CellsはダメだがOffsetを使えば問題は出ませんでした。

回答No.2

papayuka

Change でセル値を変更する場合は Changeイベントを止めないとダメです。
また、Target は 複数の場合がある（複数選んでCtrl+Enter）のでループさせてます。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, tr As Range
On Error GoTo ER:
For Each r In Target
　If r.Column >= 4 Then
　　 Application.EnableEvents = False
　　 Select Case r.Column
　　　 Case Is = 4: Set tr = r.Offset(0, 1).Resize(1, 2)
　　　 Case Is = 5: Set tr = Union(r.Offset(0, 1), r.Offset(0, -1))
　　　 Case Is = 6: Set tr = r.Offset(0, -2).Resize(1, 2)
　　　 Case Is > 6: Set tr = r.Offset(0, 4 - r.Column).Resize(1, 3)
　　 End Select
　　 tr.ClearContents
　 End If
Next r
ER:
　Application.EnableEvents = True
End Sub

お礼

回答ありがとうございます。
正常に動作することを確認しました。
Application.EnableEvents　って最初と最後だけでよかったのですね。
自分のコードではやたらFalseとTrueを繰り返していました。

回答No.1

KenKen_SP

> Target.Offset(0, 1).ClearContents

Change イベントはセルの値が変更されたとき、実行されるイベント
プロシージャですが、この Change イベントの中で、セルの値を変更
した場合も、Change イベントが発生します。

例えば、D1 セルに値が入れば、Change イベントの Target は D1
セルですね。元のコードでは、このときまず E1 セルが消去されます。
すると、次行の

> Target.Offset(0, 2).ClearContents

が実行される前に、今度は Target が E1 で Change イベントが発生
してしまいます。すると、さらに今度は Target が F1 でChange
イベントが発生...と無限ループに陥ることになります。

Change イベント内でセルの「値を変更」するときは、これを抑止
してやらなければなりません。具体的には、セルの値を変更する
タイミングだけ、

　　Application.EnableEvents = False

としてイベント発生を停止させます。処理が終わったら元に戻し
て下さい。

ご提示いただいたコードは、理論的には「無限ループとなるはず」
なのですが、たまたま上手くいっていたのでは？

> D列に値が入ればE,F列の値を削除

入力されるのは空値でも良い、つまり値の消去でも良いということ
であれば・・・

Private Sub Worksheet_Change(ByVal Target As Range)

　　Dim sCol As String

　　' // 終了条件:: 複数列が一度に変更された場合は終了
　　If Target.Columns.Count > 1 Then Exit Sub

　　' // 変更された列番号で分岐処理
　　' // 消去する列全体を表す文字列を sCol に代入
　　Select Case Target.Column
　　　　Case 4: sCol = "E:F"　　　　 ' // D列に値が入ればE,F列
　　　　Case 5: sCol = "D:D,F:F"　　 ' // E列に値が入ればD,F列
　　　　Case 6: sCol = "D:D,E:E"　　 ' // F列に値が入ればD,E列
　　　　Case Is > 6
　　　　　　　　sCol = "D:F"　　　　 ' // G列以降に値が入ればD,E,F列
　　　　Case Else
　　　　　　　　Exit Sub　　　　　　 ' // それ以外は終了
　　End Select

　　' // 変更されたセルの行全体と sCol で表される列全体の交差部分
　　' // を消去する.
　　On Error Resume Next
　　Application.EnableEvents = False
　　Intersect(Target.EntireRow, Me.Range(sCol)).ClearContents
　　Application.EnableEvents = True

End Sub

お礼

回答ありがとうございます。
提示したコードに
　Application.EnableEvents = False
　Application.EnableEvents = True
が抜けておりました(実際のコードはIf～elseifの間に↑が1回ずつ入っててみっともないですけど)。
説明させて申し訳ありません。
実際、今回のコードを組む際にしっかり無限ループを経験しました。

挙げていただいたコードで正常に動作しました。
　If Target.Columns.Count > 1 Then Exit Sub
は、外した方がより自身の目的に沿うのですが、
これは別の操作によるエラーの抑止になっていたりするのでしょうか？