[[20111217004159]]　『Worksheet_Changeイベント』（バーバラ）　ページの最後に飛ぶ

『Worksheet_Changeイベント』（バーバラ）

 また、お世話になります。WinXP,Excel2007です。
 次のようなListがあります。
 [[20040630213250]]　『計算結果の変更→指定セルへ日付を表記』（D輔）
 こちらのコードを参考にさせていただいております。

 B4:D4には、それぞれB2-B3、C2-C3、D2-D3の計算式が入っています。

	[A]	[B]	[C]	[D]	[E]	[F]
 [1]　  　　　　　4月　　　5月　　　6月       
 [2]	X        100      150      300 
 [3]	Y	 60    	70      100
 [4]	X-Y	 40   　 80　　　200				
 [5]

 このシートで、4行目の計算結果が変わる場合に、メッセージを表示するコードを
 作りたいと思います。
 B列を例にとると、単純にB4の計算結果（値）が変わった時にだけ、メッセージを
 表示させたいのです。
 いいかえると、表示させたくないのは次のようなケースです。
 ①B2に100の値貼り付けをした場合は、B4の計算式結果が変わらないので表示不要
 ②B2のセルでESC+F2で計算式を表示後、Enterをそのまま押した場合（B2の値は
　変わらない）表示不要
 ③B4のセルでESC+F2で計算式を表示後、Enterをそのまま押した場合（B2の値は
　変わらない）表示不要

 参考にして作った次のコードだと、上記①②③の場合いずれも、メッセージが
 表示されてしまいます。
 どこを修正すればよいか、ご教授いただけないでしょうか。

 Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myAfter As Variant, myBefore As Variant
    If Target.Row < 2 Or Target.Row > 4 Then Exit Sub
        Application.EnableEvents = False
        myAfter = Range("B4").Value
            If myBefore <> myAfter Then
                MsgBox "実績が変更されました！"
            End If
        Application.EnableEvents = True
 End Sub
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myBefore As Variant
    myBefore = Range("B4").Value
 End Sub

 提示のSelectionChangeとの組合せも、なかなかうまく考えた方法だけど、セルを選択せず、同じ場所で値を変更した場合は機能しない。
また、Changeイベント、SelectionChangeイベントは複数セルが対象になるケースもあって、扱いは、結構やっかい。

計算要素であるB2:D3の領域が変更されればチェックするという前提で。

 ・SelectionChangeイベントルーティンを削除
 ・Changeイベントを以下に。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant
    Dim x As Long
    If Not Intersect(Target, Range("B2:D3")) Is Nothing Then
        Application.EnableEvents = False
        Application.Undo
        v = Range("B4:D4").Value
        Application.Undo
        For x = 1 To 3
            With Cells(4, x + 1)
                If .Value <> v(1, x) Then
                    MsgBox .Address(False, False) & "の値が" & v(1, x) & "から" & .Value & "に変更されました"
                End If
            End With
        Next
        Application.EnableEvents = True
    End If
 End Sub

 (ぶらっと)

 既に投稿があるようなので、別の視点から・・・。
 >複数セルが対象になるケースもあって、扱いは、結構やっかい。
 これはそのとおりだと思いますが、
 バーバラさんのコードもせっかく投稿されたのですから、
 これを考察しないと勿体ないですねえ・・・。

 まず、これ。
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myBefore As Variant
    myBefore = Range("B4").Value
 End Sub

 変数myBeforeをプロシジャー内で宣言すると、ローカル変数になってしまいます。
 ローカル変数はプロシジャー終了時には、VBAが管理しません。
 よって、このSelectionChangeイベントが終了すれば、myBeforeという変数は
 無くなってしまいます。

 これは、プロシジャーの外でシートモジュールの先頭で　宣言してください。
 又、myBefore = Range("B4").Value　これだと常にセルB4の値を保存してしまうので

 対象シートのモジュールに

 Option Explicit
 Private myBefore As Variant
 Private Sub Worksheet_Change(ByVal Target As Range)
 ・   
 ・   
 End Sub
 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    With ActiveCell
       myBefore = Cells(4, .Column).Value
       Debug.Print myBefore
    End With
 End Sub

 なんてすると、とりあえずmyBefore という変数にその列の4行目のセル値が入ります。

 これでよいかと思いましたが、まだ100が入っているセルB2に100と入力しても
 メッセージが表示されてしまいます。

 よく見たら、

 Private mybefore As Variant
 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim myAfter As Variant, mybefore As Variant
                               ↑ここにもmybeforeが・・・。
    If Target.Row < 2 Or Target.Row > 4 Then Exit Sub
        Application.EnableEvents = False
        myAfter = Cells(4, Target.Column).Value
            If mybefore <> myAfter Then
                MsgBox "実績が変更されました！"
            End If
        Application.EnableEvents = True
 End Sub

 別言語には、データを共有するためには、あっちゃこっちゃに
 同じ変数名を宣言しないと共有変数にならないような仕様の言語もありますねえ
 （もっともそれでも書く場所は違いますが・・・）。
 VBAでは、ちょっと違います。

 モジュールレベルとプロシジャーレベルに同じ変数名を宣言してもエラーにはなりません。
 (excel2002) 
 普通にmybeforeと書くとプロシジャーレベルの変数が採用されます。

 よって、プロシジャーレベルの同じ変数を削除してください。

 これで想定動作はするはずです。

 コード自体は冒頭のとおり、まだ問題を抱えていますが、
 変数のスコープについて、気になったので投稿しました。

 ichinose

 ぶらっとさん
 コードありがとうございます。
 思い通り動いています。
 コードは今から読ませていただきますが、その前に１つだけ質問させてください。
 >If Not Intersect(Target, Range("B2:D3")) Is Nothing Then
 これを日本語に訳すと、TargetとRange("B2:D3")の共有範囲が０でない場合
 ⇒共有範囲がある場合
 ⇒要は、TargetがRange("B2:D3")に含まれる場合と理解してよいですよね？

 ichinoseさん
 変数の件、ご指摘ありがとうございます。実は、何となくは気付いておりました。
 参照させていただいた元のコードは正しく、モジュールの先頭で変数宣言しておりました。
 私は、プロシージャの外で変数を宣言する機会が無かったため（恥。。）、勝手に、頭の中で
 変換して書いてしまったようです。
 確かに、修正すると想定した動作をえられました。大変勉強になりました。

 追記：過去の質問を参照させていただく際、番号をリンク表示するためには、
 どのように投稿すればよいのでしょうか。単純なコピペではだめなのでしょうか。
 （バーバラ）

 >これを日本語に訳すと、TargetとRange("B2:D3")の共有範囲が０でない場合
 >⇒共有範囲がある場合
 >⇒要は、TargetがRange("B2:D3")に含まれる場合と理解してよいですよね？

 それでＯＫ。変更されたセルがB2:D3の範囲にある場合。

 >過去の質問を参照させていただく際、番号をリンク表示

 過去のスレッドの頭の　[[2011xxxxxxxxxx]] タイトル (ＨＮ）これをコピペ。たとえば

[[20111217013817]]　『語句の検索と抽出マクロ』（のぼ）

 (ぶらっと)

 ぶらっとさんのコードで、２つあるApplication.Undoがどういう動作をしているかわかりません。
 ※これを削除すると思い通りの動作をしないことは確認できたのですが、、、
 ヘルプには「ユーザーが最後に実行した操作を取り消して元に戻します」とあります。
 ここでいう「ユーザーが最後に実行した操作」というのは、何を想定しているのでしょうか。
 セルの値が変更されたこと、でしょうか。
 同じコードが２つあることにどのような意味があるかご教授いただけないでしょうか。
 （バーバラ）

 意味としては｢元に戻す｣
たとえばエクセルで、どこかのセルにaaaaと入力->bbbbと入力->ccccと入力。
この状態で｢元に戻す｣ボタンを押していくと->bbbb->aaaa と戻っていくね。
さらに、｢やり直し｣ボタンを押すと、->bbbb->cccc と変わっていくね。
本来は、この｢元に戻す｣が｢UnDo｣、｢やり直し｣は｢ReDo｣とでもいうべきだけど、
VBAにはApplication.Redoが用意されていない。

 ところが、バグか仕様かはわからないけど、あるセルにaaaa -> bbbb ->cccc と入れた状態で

 Sub Test()
   Application.Redo
 End Sub

 このマクロを実行すると ->bbbb->cccc->bbbb->cccc ・・・・こうなる。
つまり、VBAのApplication.UnDo は　どうも、｢元に戻す｣と｢取り消し｣が交互に実行されると考えられる。

 なので、いったん、シート上の入力でChangeイベントルーティンに入った時点で、Application.UnDo で
入力前の状態に戻して、入力前の値を取り込み、そのあと、｢取り消し｣をすることにより、入力された状態に
戻し、入力前と後の値を比較。

 なお、この｢元戻し｣や｢取り消し｣によってセルの値が変わる。本来なら、ここで連鎖的にChangeイベントが発生して
このプロシジャに再入してくる。結果として無限連鎖の不具合が発生する、なので、セルの値を変更する前に
Application.EnableEvents = False でイベントの発生を抑止し、処理後に、Application.EnableEvents = True で
イベント発生を再開させている。

 (ぶらっと)

 ぶらっとさん
 返事が遅くなりました。
 >VBAのApplication.UnDo は　どうも、｢元に戻す｣と｢取り消し｣が交互に実行されると考えられる。
 確認できました。

 >なので、いったん、シート上の入力でChangeイベントルーティンに入った時点で、Application.UnDo
 >で入力前の状態に戻して、入力前の値を取り込み、そのあと、｢取り消し｣をすることにより、入力
 >された状態に戻し、入力前と後の値を比較。
 なるほど～。丁寧に解説いただきまして、ありがとうございました。
 （バーバラ）

 実際のファイルでエラーが出たので、相談させてください。
 上記のデータが「Sheet1」にあるとします。
 Sub Copy1()
 Sheets("Sheet1").Range("B3").Value = Sheets("Sheet1").Range("H3").Value
 End Sub
 ここで、H3にある数値を、このコードでB3に転記すると、次のエラーがでます。
 実行エラー'1004'
 'Undo'メソッドは失敗しました:'_Application'オブジェクト

 エラーが出た後にもう一度、上記コードを実行すると、このエラーはでません。
 １回目に上記コードを実行したときに、このエラーが出る理由はなぜなのでしょうか。
 ２回目に実行したときに、エラーが出ない理由はなぜなのでしょうか。
 Selectしていないからかとも思ったのですが、だとすると２回目の実行時にはエラーが出ない
 理由がどうも不明です。
 どなたかご教授いただけませんか？
 （バーバラ）

 わぁお！！まいったね。
↑の　Copy1を実行したとき、エクセル画面の｢元に戻す｣ボタンも｢取り消し｣ボタンも白くなって
選べなくなっているよね。あくまで｢操作で入力｣したときにUnDoが有効になる。
二度目にエラーにならなかったのは、
Appliction.EnableEvents = Flase にしっぱなしでプロシジャが終了しており、次のCopy1の結果では
Changeイベントが発生していないだけのこと。

 う～ん・・マクロで値を変更することは想定外だった。対応策、どうするか考えるね。

 (ぶらっと)

 当該の領域にマクロで値を転記するケースをサポートする方法として
１．マクロでセットするところで、イベント抑止->転記実行->メッセージ処理->イベント再開。
　値の転記のコードごとに記述するのは煩雑だし、サブプロシジャ仕立てにすることになるけど
　お勧めはしないので、対応コード案も割愛。
２．UnDo処理にエラートラップを仕掛けて、マクロでの変更時には、「値がかわった（はず）」という
　メッセージのみ表示。
３．UnDoを使わず、まったく別の方法で。

 以下に、この２，３のコード案を。

 ２．の案。現行どおりシートモジュール。

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant
    Dim x As Long
    Dim myErr As Long

    If Not Intersect(Target, Range("B2:D3")) Is Nothing Then
        Application.EnableEvents = False
        On Error Resume Next
        Application.Undo
        myErr = Err.Number
        On Error GoTo 0
        If myErr > 0 Then
            MsgBox "値が変わったはずですよ"
        Else
            v = Range("B4:D4").Value
            Application.Undo
            For x = 1 To 3
                With Cells(4, x + 1)
                    If .Value <> v(1, x) Then
                        MsgBox .Address(False, False) & "の値が" & v(1, x) & "から" & .Value & "に変更されました"
                    End If
                End With
            Next
        End If
        Application.EnableEvents = True
    End If
 End Sub

 ３．別案。コード記述場所を１つにまとめるほうが保守性が増すので、現行のシートモジュールのコードを消して
　　ThisWorkbookモジュールに以下。

 Option Explicit

 Dim v As Variant
 Const shn As String = "Sheet1" '対象シート名　実際の名前に変更

 Private Sub Workbook_Open()
    v = Sheets(shn).Range("B4:D4").Value
 End Sub

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Long

    If Not Sh Is Sheets(shn) Then Exit Sub

    If Not Intersect(Target, Sh.Range("B2:D3")) Is Nothing Then
        For x = 1 To 3
            With Sh.Cells(4, x + 1)
                If .Value <> v(1, x) Then
                    MsgBox .Address(False, False) & "の値が" & v(1, x) & "から" & .Value & "に変更されました"
                End If
            End With
        Next

        v = Sh.Range("B4:D4").Value

    End If

 End Sub

 (ぶらっと)

 ぶらっとさん
 お礼がおそくなりました。　
 早々に２つも提示いただきまして、ありがとうございます。
 これから読ませていただきます。
 （バーバラ）

 PCにジュースをこぼしてしまい、データ復旧中です。。。ｵｲ
 しばらく検証できません。せっかく作っていただいたのに、申し訳ありません。
 必ず回答いたしますので、しばらくお待ち願います。 
（バーバラ）

 なんとか戻りました。
 お礼が遅れて申し訳ありません、ありがとうございました。
 ３を考えたいと思います。

 実行すると、
 If .Value <> v(1, x) Then
 ここで実行時エラー 13 型が一致しません、と出ます。
 ウォッチウインドウで見てみると、
 .Valueは、Value2の箇所がDouble、v(1, x)は、Integerとなっています。
 ここが原因なのでしょうか。
 （バーバラ）

 >ここで実行時エラー 13 型が一致しません、と出ます。

 う～ん・・こちらでは、異なるデータ型のデータをいれてもエラー再現しないなぁ。
以下、教えて。

 １．B4～D4には、どんな式が入っている？
 ２．エラーがあったとき、どこかに値をいれる前のB2～D3の値がどうなっていたか、
     入れた値は、どこに何をいれたか。

 20:47 追記
　比較しているいずれかが｢エラー値｣ということはないかな？
　計算式の結果がエラー値ということは、ありうることだから、その場合も大丈夫なように
　手当てしなきゃいけないけど、とにかく原因が、エラー値かどうか確認したい。

 (ぶらっと)

 たぶん、エラー値の場合の不具合だと思うので、Workbook_SheetChangeを以下に差し替えて試してみて。

 Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim x As Long
    Dim d1 As Variant, d2 As Variant

    If Not Sh Is Sheets(shn) Then Exit Sub

    If Not Intersect(Target, Sh.Range("B2:D3")) Is Nothing Then
        For x = 1 To 3
            With Sh.Cells(4, x + 1)
                d1 = .Value
                d2 = v(1, x)
                If IsError(d1) Then d1 = Empty
                If IsError(d2) Then d2 = Empty
                If d1 <> d2 Then
                    MsgBox .Address(False, False) & "の値が[" & d2 & "]から[" & d1 & "]に変更されました"
                End If
            End With
        Next

        v = Sh.Range("B4:D4").Value

    End If

 End Sub

 (ぶらっと)

 ぶらっとさん
 いろいろありまして（さぼりもありました。。）今さらの回答になりました。
 申し訳ありません。

 >１．B4～D4には、どんな式が入っている？
 B4=B2-B3,C4=C2-C3,D4=D2-D3です。

 >２．エラーがあったとき、どこかに値をいれる前のB2～D3の値がどうなっていたか、
 >    入れた値は、どこに何をいれたか。
 K3からB3に値を貼り付ける次のマクロを実行後
 Sheets("Sheet1").Range("B3").Value = Sheets("Sheet1").Range("K3").Value
 L3からB3に値を貼り付ける次のマクロに変更して
 Sheets("Sheet1").Range("B3").Value = Sheets("Sheet1").Range("L3").Value
 実行すると、次のエラーがでます。
 >ここで実行時エラー 13 型が一致しません、と出ます。
 ただ、保存して開きなおすとエラーが出なくなりましたので、
 本件、クローズさせていただきます。
 また、よろしくお願いいたします。
 (バーバラ)

コメント返信：

[ 一覧(最新更新順) ]

[[20111217004159]] 『Worksheet_Changeイベント』（バーバラ） ページの最後に飛ぶ

[[20111217004159]]　『Worksheet_Changeイベント』（バーバラ）　ページの最後に飛ぶ