エクセルの特定のセルの値が変化したらマクロを自動実行させたい。

質問

エクセルの特定のセルの値が変化したらマクロを自動実行させたい。

エクセルにてシート１のＢ５に英数字を入力すると
シート２のＡ列を検索し同じ値があるとその行のＢ列にある値をＨ６に表示をします。

　【例】
　　シート１のＢ５に「Ａ５６８４」と入力

　　シート２
　　　　A　　　B
　　1：A5682　パイン　
　　2：A5683　リンゴ
　　3：A5684　バナナ

　　シート１のＨ６に「バナナ」と表示される

シート２のＡ列にない場合はメッセージボックスで「データがありません」と表示します。
またシート３のＡ1に数字を入れておき、以下のマクロ、

　'Sheet３から印刷すべき連番を獲得します。
Worksheets("Sheet３").Select
Range("A1").Select
番号 = ActiveCell
連番 = "A" & Application.WorksheetFunction.Rept("0", 5 - Len(番号)) & 番号
　'Sheet３の番号セル「B1」を更新します
番号 = 番号 + 1
ActiveCell.FormulaR1C1 = 番号
　'Sheet１のセル「H７」欄に連番を表示します。
Worksheets("シート３").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = 連番
Worksheets("シート１").Select
Range("H6").Select '調べたいセルを記入
If IsError(ActiveCell.Value) Then
errval = ActiveCell.Value
Select Case errval
Case CVErr(xlErrDiv0)
MsgBox "#DIV/0! エラー"
Case CVErr(xlErrNA)
If vbOK = MsgBox(" データがありません") Then Exit Sub

End Select
End If

Sheets("シート１").PrintOut Copies:=1
Range("B5").Select
Selection.ClearContents '消去
Range("B5").Select
End Sub

でシート１のＨ７に（＝シート３!B1）として
印刷ごとに１、２、３、と連番を入れています。

フォームで作成したボタンを押すとＨ６とＨ７の値が印刷されます。
そしてＢ５の値がDeleteされ（よってＨ６は#N/Aとなる）
Ｂ５にカーソルが行って入力待ち状態になるようにしてあります。

これで、シート１のＢ５の値が変化又はＨ６が変化したら
印刷ボタンを押して印刷ではなく自動印刷されるように出来ますか？

Private Sub Worksheet_Change(ByVal Target As Range)　
If Target.Column = B And Target.Row = 5 Then
を使いましたが
「コンパイルエラー」とか
Targetの所が色つきになって「End　Sub」が必要です。

となってうまく出来ません。

お願いします。

回答No.2

mu2011 · ベストアンサー

NO1です。
Ｂ５セルクリア毎に起動されるので、次の様に割り込み停止と開始を設定すれば動作すると思います。
Application.EnableEvents = False
Range("B5").Select
Selection.ClearContents '消去
Range("B5").Select
Application.EnableEvents = True

お礼

私の能力不足で、うまく動作してくれません。
コンパイルエラー等は無くなりましたが、
対象データが無くメッセージボックスが出て
印刷を止める状態なのですが、
#N/Aが印刷後メッセージボックスが出たりして
思ったとうりに動作しません。

ご丁寧に回答をしていただきましてありがとうございました。

回答No.1

mu2011

一例です。
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Union(Range("B5"), Range("H6"))) Is Nothing Then Exit Sub
～印刷～
End Sub

補足

今はフォームで作成したボタン（印刷ボタン）をおすと
以下のマクロが動きます。
Ｂ５又はＨ６のセルの値が変化したら
以下のマクロを自動で動かしたいのですが
可能でしょうか？

'Sheet３から印刷すべき連番を獲得します。
Worksheets("Sheet３").Select
Range("A1").Select
番号 = ActiveCell
連番 = "A" & Application.WorksheetFunction.Rept("0", 5 - Len(番号)) & 番号
　'Sheet３の番号セル「B1」を更新します
番号 = 番号 + 1
ActiveCell.FormulaR1C1 = 番号
　'Sheet１のセル「H７」欄に連番を表示します。
Worksheets("シート３").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = 連番
Worksheets("シート１").Select
Range("H6").Select '調べたいセルを記入
If IsError(ActiveCell.Value) Then
errval = ActiveCell.Value
Select Case errval
Case CVErr(xlErrDiv0)
MsgBox "#DIV/0! エラー"
Case CVErr(xlErrNA)
If vbOK = MsgBox(" データがありません") Then Exit Sub

End Select
End If

Sheets("シート１").PrintOut Copies:=1
Range("B5").Select
Selection.ClearContents '消去
Range("B5").Select
End Sub