エクセルVBAで内容変更のたびに自動実行するには？

質問

エクセルVBAでBOOK1のsheet1とsheet2とsheet3とsheet4があり、
sheet1とsheet2とsheet3の全ての情報をsheet4にコピーしてまとめるようにしました。
マクロを実行するには、Visual Basicを開いてF5を押しています。

それをsheet1かsheet2かsheet3の中身の一部分でも変更すると
そのときに自動的にマクロが実行されるようにしたいです。

エクセルを開いたときやsheetをアクティブにしたとき、日時を指定して実行させる
という説明はみつけましたが、sheet内の変更で実行というものはみつかりませんでした。

どのようにすれば良いのでしょうか？
よろしくお願いいたします。

回答No.1

mshr1962 · ベストアンサー

Sheet1,2,3それぞれのコード欄にて

Private Sub Worksheet_Change(ByVal Target As Range)

処理マクロ

End Sub

として実行させるか

Private Sub Worksheet_Change(ByVal Target As Range)

Call 処理マクロ名

End Sub

で別モジュール上のマクロを呼び出して実行してください。

お礼

ありがとうございました。

補足

ありがとうございます。

Sub マクロ()

Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub

これを↓のように変更しましたが、sheet1やsheet2のセルの内容（文章、色など）を変更してもsheet3に反映されませんでした。

Private Sub Worksheet_Change(ByVal Target As Range)

'ここから下は変更はありません。
Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub

回答No.5

kmetu

シートの変更処理の中で再度シート内の変更
Rows(RowCount).Delete
をしてるようなので

以下のように

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

実行したいマクロ

Application.EnableEvents = True

End Sub

と

Application.EnableEvents
の処理を追加してください。

お礼

ありがとうございました。

回答No.4

myi333

こんにちわ　初心者ですが間違っていたらごめんなさい
スレ主様は、コードを「標準モジュール」記述していませんか？
先に回答している方も書いている通り記述先は「seet1,2,3のコードウィンドウ」のChangeイベントです。
http://okwave.jp/qa/q685091.html

お礼

ありがとうございました。

補足

sheet1とsheet2とsheet3に

Private Sub Worksheet_Change(ByVal Target As Range)
Call マクロ()
End Sub

を入れ、

標準モジュールに

Sub マクロ()

Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub

をやって、sheet1かsheet2のセルを変更すると
エクセルが固まってしまいます。
デバックでは最初の
Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")
がよくないようです。
書き方が間違っているのでしょうか？

回答No.3

imogasi

＞sheet内の変更
の「変更」の意味・範囲があいまいです。経験が余りなくて、色んなケースを想像できないのでしょうが。
「セルの値の変更」に限れば、下記が参考になるかも。
セルの属性に限っても、セルの値のほかに表示形式やコメントなど色々あるのを意識してますか？
ーー
勉強する方向は、「イベント」に関することだと思う。シートに限って言えば
（１）各シートでシートの
シートタブで右クリックー「コードの表示」で出て来る画面で
Ｇｅｎｅｒａｌ部でＷｏｒｋｓｈｅｅｔ　Ｄｅｃｌａｌａｔｉｏｎ部でＣｈａｎｇｅを指定して
Private Sub Worksheet_Change(ByVal Target As Range)
End Sub
などを使う
（２）プロジェクトエクスプローラー部のＴｈｉｓＷｏｒｋＢｏoｋでＳｈｈｅｔＣｈａｎｇｅ
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
End Sub
を使うことをやってみてください。
ーー
後者の参考
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
MsgBox Sh.Name & " " & Target.Address
End Sub
シート名をＳｈｅｅｔ１，Ｓｈｅｅｔ２、Ｓｈｅｅｔ３にＶＢＡコードで限定すれば、その３シートを対象にした変更だけコードが書ける。
ーー
しかしこれで操作的（取り消しなども含めて）に、データ入力的（抹消・挿入なども含めて）に色々やってみて、ニーズを満たすかどうか？
私は疑問を持ちますのですが。
ーー
初心者は即時反応性を望む。本源的にはそれが望ましいが、ウインドウズ以前の昔の時代のコンピュター処理を見てきたものには大変なことだと思うから控えめに考える。
エクセルは、ＶＢＡ程度だけで、突き詰めて即時反応性を追求するのは、関数を除いて難しいと思う。
必要の都度その時点（でボタンでも押させて）のデータで、ＶＢＡで改めて「まとめる」直すのが素直では。

お礼

ありがとうございました。

補足

ありがとうございます。

Sub マクロ()

Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub

これを↓のように変更しましたが、sheet1やsheet2のセルの内容（文章、色など）を変更してもsheet3に反映されませんでした。

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

'ここから下は変更はありません。
Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub

回答No.2

kmetu

各シートのマクロで

Private Sub Worksheet_Change(ByVal Target As Range)

実行したいマクロ

End Sub

を設定するか

ThsiWorkbookのマクロで

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

If Sh.Name <> "Sheet4" Then
実行したいマクロ
End If

End Sub

といった設定にしてください。

お礼

ありがとうございました。

補足

ありがとうございます。

Sub マクロ()

Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub

これを↓のように変更しましたが、sheet1やsheet2のセルの内容（文章、色など）を変更してもsheet3に反映されませんでした。

Private Sub Worksheet_Change(ByVal Target As Range)

'ここから下は変更はありません。
Workbooks("BOOK.xlsm").Worksheets("sheet1").Range("C1:BE50").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C1:BE50")

Workbooks("BOOK.xlsm").Worksheets("sheet2").Range("C1:BE100").Copy _
Destination:=Workbooks("BOOK.xlsm").Worksheets("sheet3").Range("C51:BE150")

Dim UsedCell As Range
Dim Max_Row, RowCount As Integer

Set UsedCell = ActiveSheet.UsedRange

Max_Row = UsedCell.Cells(UsedCell.Count).Row
Application.ScreenUpdating = False
For RowCount = Max_Row To 1 Step -1

If Application.WorksheetFunction.CountA(Rows(RowCount)) = 0 Then
Rows(RowCount).Delete
End If
Next
Application.ScreenUpdating = True

End Sub