みんなの「教えて(疑問・質問)」にみんなで「答える」Q&Aコミュニティ

こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセルVBAでエラー、Changeの使い方が×?

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

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

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")
がよくないようです。
書き方が間違っているのでしょうか?

投稿日時 - 2011-09-05 17:35:30

QNo.6991368

すぐに回答ほしいです

質問者が選んだベストアンサー

>この部分は削除しても動くので問題なさそうなのですが、
>削除して↓のコードで大丈夫ですよね???

Sheet1やSheet2で、空白行を削除して上に詰める
必要がないのでしたら、削除しても大丈夫です。

Sheet1やSheet2で、1行空けて入力するとか
データを1行消す(※行削除ではなく)とかすると
ある場合とない場合の違いが分かると思います。

投稿日時 - 2011-09-09 13:18:39

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(8)

ANo.7

No.3,4,6です。

今のマクロだと、ますアクティブシートの編集した範囲より上の空白行を削除して
それからSheet1の1行目から50行目の内容をSheet3の1行目から50行目に
Sheet2の1行目から100行目の内容をSheet3の51行目から150行目に
それぞれ転記すると思いますが、Sheet1とSheet2の間の空白が消えないということは
もしかして、Sheet1から転記したデータが50行に満たない場合は
51行目以降のSheet2から転記したデータをさらに上に詰めたいということでしょうか?

それなら、マクロの最後に

For RowCount = 150 To 1 Step -1
If Application.WorksheetFunction.CountA(Worksheets("sheet3").Rows(RowCount)) = 0 Then
Worksheets("sheet3").Rows(RowCount).Delete
End If
Next

(アクティブシートではなくSheet3固定で、150行目までの空白行を削除)
を追加すればいいのではないかと思います。

意図を取り違えていたらすみません。

投稿日時 - 2011-09-09 00:18:23

お礼

ありがとうございます。
やりたいことが実現しました。


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

この部分は削除しても動くので問題なさそうなのですが、
削除して↓のコードで大丈夫ですよね???

Sub マクロ()

Worksheets("sheet1").Range("B1:BE50").Copy _
Destination:=Worksheets("sheet3").Range("B1:BE50")

Worksheets("sheet2").Range("B1:BE100").Copy _
Destination:=Worksheets("sheet3").Range("B51:BE150")

For RowCount = 150 To 1 Step -1
If Application.WorksheetFunction.CountA(Worksheets("sheet3").Rows(RowCount)) = 0 Then
Worksheets("sheet3").Rows(RowCount).Delete
End If
Next

End Sub

投稿日時 - 2011-09-09 12:02:51

ANo.6

No.3,4です。

私がNo.4に書いた方法は試されたのでしょうか。
マクロの前後に
Application.EnableEvents = False

Application.EnableEvents = True
を入れただけでは、No.5の補足に書いたような状態になるので
マクロでの処理を「空白行を詰める→Sheet3に転記」
の順番に変える、と書いたのですが。

投稿日時 - 2011-09-08 19:41:58

補足

返事が遅れてしまい、すみません。

標準モジュールには、

Sub マクロ()

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


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")

End Sub

そして、
Sheet1(VBAの)とSheet2(VBAの)には

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Call マクロ
Application.EnableEvents = True
End Sub

Sheet3(VBAの)は空白です。


このようにやると、
sheet1(エクセルの)とsheet2(エクセルの)の内容を変更すると、
sheet3(エクセルの)に
sheet1(エクセルの)の内容の下にsheet2(エクセルの)が
自動的にコピーされますが、
sheet1(エクセルの)とsheet2(エクセルの)の
間にある空白行が消えません。

投稿日時 - 2011-09-08 21:12:12

ANo.5

> Private Sub Worksheet_Change(ByVal Target As Range)
> application.enableevents=false
> Call マクロ()
> application.enableevents=true
> End Sub
>
> こういうことでしょうか?

やってみた結果はどうでしたか?

投稿日時 - 2011-09-08 14:51:56

補足

ありがとうございます。
試してみました。

結果は、sheet1とsheet2の内容を変更したとき自動でちゃんとsheet3にコピーされました。
しかし、
空白行は自動で削除されないため、
手動でマクロを実行しなければいけません。
実行すれば正しく空白行が削除されます。

投稿日時 - 2011-09-08 15:10:59

ANo.4

No.3です。
すみません、後半部分をよく見ていませんでした。
これは空白行を削除して上に詰めているのですね?
Sheet3にも、この詰めた状態で反映させたいのだとすると

・空白行の削除は、データのコピーの前に行う
>Dim UsedCell As Range
以降の部分を、マクロの最初に持ってくる

・マクロ実行時に、一時的にイベントが発生しないようにする
マクロの最初に 
Application.EnableEvents = False
最後に
Application.EnableEvents = True
を追加

この二点の修正でどうでしょうか。

No.3では、Sheet3の

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

の部分を削除すればいい、と書きましたが
Sheet3を直接編集させたくないのであれば
入れたままにしておいていいです。

投稿日時 - 2011-09-06 09:26:44

ANo.3

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

これをSheet3に入れてあるのがまずいのでは。

Sheet1またはSheet2のChangeイベントで、マクロが実行される。

マクロによってSheet3の内容が書き換わる。

Sheet3のChangeイベントが発生し、再度マクロが実行される。

マクロによって再度Sheet3の内容が書き換わる。

再度Sheet3のChangeイベントが発生。

こんな感じで無限ループしているわけです。

やりたいことの趣旨から考えると、Sheet3から
上記の部分を消すのが手っ取り早いと思います。

投稿日時 - 2011-09-05 18:26:02

補足

ありがとうございます。
まさにその通りでした。
試してみると、
最初のエラーの部分を通り抜けました。
しかし、
最後から5行目の
Rows(RowCount).Delete
でエラーになってしまいます。

すみません、また教えて頂けないでしょうか。

投稿日時 - 2011-09-05 21:57:16

ANo.2

この質問を読んだだけで、実際に検証していないので、間違っているかもしれませんが、、、

マクロの最初でコピーしたときに、コピー先の値が変わる(同じ値でも、上書きしているので、書き換えたことになります)ので、そのタイミングでまたチェンジイベントが発生してしまいます。

よって、最初のコピーを延々と無限に続けることになります。

最初のコピーよりも前に
application.enableevents=false
と書いて、イベントを発生させないようにしましょう。

マクロの最後で、
application.enableevents=true
と書いて、イベントを発生させるように戻すのを忘れずに。

間違っていたらごめんなさい。

投稿日時 - 2011-09-05 17:57:41

補足

Private Sub Worksheet_Change(ByVal Target As Range)
application.enableevents=false
Call マクロ()
application.enableevents=true
End Sub

こういうことでしょうか?

投稿日時 - 2011-09-05 21:59:33

ANo.1

sheet1とsheet2とsheet3に

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


----------------------------------------------------------

sheet3には不要なソースではないでしょうか???

投稿日時 - 2011-09-05 17:55:36

補足

ありがとうございます。
まさにその通りでした。
試してみると、
最初のエラーの部分を通り抜けました。
しかし、
最後から5行目の
Rows(RowCount).Delete
でエラーになってしまいます。

すみません、また教えて頂けないでしょうか。

投稿日時 - 2011-09-05 21:57:31

あなたにオススメの質問