ワークシートのChangeイベントについて

質問

シート１のA1セルの値を変更したらシート２のA1・A2・A3と変更内容を順に記録するような以下のようなコードがありますが、うまく動作しません。問題点を指摘していただければ大変助かります。

【Worksheet】
Private Sub Worksheet_Change(ByVal Target As Range)
Static r
Dim s As Range
Set s = Sheets("sheet1").Range("$a$1").Value
If s Is Nothing Then
Else
If r = "" Then r = 1

Sheets("sheet2").Cells(r, 1) = Sheets"sheet1").Range("$a$1").Value

r = r + 1
End If
End Sub

回答No.6

komet163

お返事おくれてごめんなさい。
２行目の With ステートメント で、
Worksheets("Sheet2") を事前定義しています。
以降、７行目の End With ステートメントまで、
.(ドット)の前に、Worksheets("Sheet2") が掛りります。

省略ではなくて、事前に定義ってことで(^^;
With を多用すると、コードが見やすく、短時間
でメンテできます。

回答No.5

komet163

こんにちは。
以下は Sheet1!A1 を Sheet2 の A列に記録しますが、
記録順が降順になります。（A1 が最新記録）
実行前に、Sheet2 を全クリアしておいてください。

Private Sub Worksheet_Change(ByVal Target As Range)
With Worksheets("Sheet2")
　If .Range("A1") <> Range("A1") Then
　　.Rows(1).Insert Shift:=xlDown
　　.Range("A1") = Range("A1")
　End If
End With
End Sub

補足

回答ありがとうございます
3行目のIf .Range("A1") <> Range("A1") Then
の右側のRange("A1")はWorksheets("Sheet2")
を省略していると考えてよろしいのでしょうか？

回答No.4

Wendy02

こんにちは。

#1 のWendy02 です。

「シート２のA1・A2・A3と変更内容を順に記録する」

このような場合は、この種のコードは、非常にミスをしやすいです。チェックの際は、必ず「Sheet2が空の状態」から、お調べください。

それから、列の最後の2行目(65535行目）でストップが掛かるようになっています。そうしたら、データを消してください。

'<シートモジュール>
Private Sub Worksheet_Change(ByVal Target As Range)
　 Dim num As Long
　 If Intersect(Target, Range("B1:C1")) Is Nothing Then Exit Sub
　 If IsEmpty(Range("B1")) Or IsEmpty(Range("C1")) Then Exit Sub
　 With Worksheets("Sheet2")
　　　num = .Range("A65536").End(xlUp).Row
　　　If num = 1 And IsEmpty(.Cells(num, 1)) Then
　　　　 .Cells(num, 1).Value = Range("A1").Value
　　　ElseIf num = 65535 Then
　　　　 MsgBox .Name & "の列のデータを空にしてください。", vbCritical
　　　　 Application.Goto .Cells(num, 1)
　　　　 Exit Sub
　　　Else
　　　　 .Cells(num, 1).Offset(1).Value = Range("A1").Value
　　　End If
　 End With
End Sub

お礼

本当にありがとうございました
ねらった通りの処理を実行できました。
これから細かい検証とコードの研究をさせていただきたいと思います。

また質問させていただくかもしれませんが、その際はよろしくお願いします。

回答No.3

imogasi

Ｃｈａｎｇｅイベントで気をつけないといけないのは、Ｃｈａｎｇｅの結果
プログラムの中で、値を変更すると、またＣｈａｎｇｅイベントが起こる、ぐるぐる回りになることです。
防ぐためにＡｐｐｌｉｃａｔｉｏｎ．ＥｎａｂｌｅＥｖｅｎｔｓ＝Ｆａｌｓｅを入れます。脱出時にＴｒｕｅに戻します。
朝時間がないの、質問例を試してませんが、上記の件は大丈夫ですか。

お礼

ありがとうございます
今のところは大丈夫なのですが
これからの参考にさせていただきます

回答No.2

KenKen_SP

こんにちは。KenKen_SP です。

修正履歴を記録するコードみたいですね。ポイントは次の2点です。

　※1　コードを実行するセルの限定（指定）
　※2　Sheet2 の最終セル＝記録先セルを取得する方法

※2について、ご提示いただいたコードは Static 変数で記録先の行番号
を保持する方法です。

この方法の問題点は Wendy02 さんご指摘のとおり、ブックを閉じてしま
うと当然 Static 変数の内容もクリアされ、次にブックを開いたときに
記録先の行番号が取得できなくなってしまいます。

したがって、履歴をとることが目的であれば、別の方法を考えなければ
なりません。

#1 の補足を考慮し、簡単な例外処理を加えてコードを書いてみました。
が、例外処理を書くとコードが長くなるので、例えばSheet2が保護され
た場合などまではカバーしてません。

Private Sub Worksheet_Change(ByVal Target As Range)

　　'※1 値が変化したセル（Target） が B1、C1 セル以外なら終了
　　If Intersect(Target, Me.Range("B1:C1")) Is Nothing Then
　　　　Exit Sub
　　End If

　　'※2 記録先セルを求める
　　Dim rngC As Range
　　On Error Resume Next
　　Set rngC = ThisWorkbook.Sheets("Sheet2") _
　　　　.Cells(1, 1).End(xlDown)
　　If Not IsEmpty(rngC.Value) Then
　　　　Set rngC = rngC.Offset(1, 0)
　　End If
　　If Err.Number > 0 Then GoTo ErrorHandler

　　'記録
　　rngC.Value = Me.Range("A1").Value

Terminate:
　　On Error GoTo 0
　　Set rngC = Nothing
　　Exit Sub

ErrorHandler:
　　MsgBox "記録用シートがないか、または最大記録数を超えました", _
　　　　　　vbCritical, "エラー"
　　Resume Terminate

End Sub

お礼

丁寧な回答ありがとうございました
とても参考なりました
ありがとうございました

回答No.1

Wendy02

こんばんは。

似たようなコードを見覚えがあります。内容的には、それを書き加えたもののようですが、基本的に、そのような内容では、Static は使わないですね。それは、Static がブックを閉じたら、行数が消えてしまいますからね。

'<Sheet1モジュール>
Private Sub Worksheet_Change(ByVal Target As Range)
　 Dim num As Long
　 If Target.Address <> "$A$1" Then Exit Sub
　 If IsEmpty(Target) Then Exit Sub
　 With Worksheets("Sheet2")
　　　num = .Range("A65536").End(xlUp).Row
　　　If num = 1 And IsEmpty(.Cells(num, 1)) Then
　　　　 .Cells(num, 1).Value = Target.Value
　　　　 Else
　　　　 .Cells(num, 1).Offset(1).Value = Target.Value
　　　End If
　 End With
End Sub

とりあえず、これで様子をみてください。
他に、条件がある場合、この限りではありません。

補足

回答ありがとうございます。
すみません実はA1セルに直に数値を入力しませんで
A1＝B1＋C1
となっておりまして、値が直に変わるのは、B1またはC1セルでした。
（そこでStatic で保持しているのかも？）
となりますと、回答いただいたコードではChangeでひろってくれないようです。

よろしくお願いいたします。