都道府県穴埋めゲーム

実行時エラー '1004'「RangeクラスのPasteSpecialメソッドが失敗」
というエラーが実行時に出たり出なかったりします。
常にエラーが出てくれればそれはそれで(?)いいのですが、普通に実行できることもあるので自分には対処できませんでした。。。

ある形式に沿って保存されている大きめのファイル(4つで1組)をマクロによって数式処理させるマクロとなります。
このデータが大きく、マシンパワーもあまりないため開いたり閉じたり、またコピーペーストにと各所で処理に多少時間が掛かるので、それが問題かなとも思い処理の間に待ち時間を挿入したりしてみたのですが、その際にはエラーが出る確率は有意に低くはなりましたが、まだ出てしまいます。

エラーした際にデバッグすると下のような処理の中でのPasteSpecialにハイライトが掛かっており、4つのうちどれでも起こりうるようです。

原因とその解決策を教えて頂きたいと思います。宜しくお願いします。

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


'対象のファイルを開いてコピー、その後閉じる
Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & ActiveCell.Offset(i, 0).Range("A1").Value
Range("E1:E500000").Select
Selection.Copy
Application.DisplayAlerts = False
ActiveWindow.Close
Application.DisplayAlerts = True
'myfileに4つを貼り付け(今回は省略してますがForで回して4つ出揃った後、それらで数式処理)
Workbooks(myfile).Activate
If j = 1 Then
 Range("G3").Select
 Selection.PasteSpecial
ElseIf j = 2 Then
 Range("H3").Select
 Selection.PasteSpecial
ElseIf j = 3 Then
 Range("I3").Select
 Selection.PasteSpecial
ElseIf j = 4 Then
 Range("J3").Select
 Selection.PasteSpecial
End If

A 回答 (2件)

> 原因とその解決策を教えて頂きたいと思います。



遅すぎたかもしれませんが(汗)、自分の知っている範囲で・・・
(自分は専らAccess VBAばかり扱っているので)

【原因】
PasteSpecialを実行する前に、その参照元となるブックが
閉じられたことにより、その前に行った「Select」による選択が
無効化してしまっています。
(エラーにならないことがあるのは・・・別のブックが「Active
 Workbook」と判断されて閉じられていたりしないでしょうか(汗))

【解決策】
PasteSpecialを実行する前の「ActiveWindow.Close」を
やめて、PasteSpecialの実行後に、コピー元のブックを
閉じるようにします。

このとき、閉じる対象を確実に「コピー元のブック」とするために、
コピー元を開く際の「Workbooks.Open」の戻り値を、変数に
記録しておき、これを使用してブックを閉じます。

【コード】
'コピー元を記録するための変数を宣言
Dim Wkb As Workbook, Rng As Range

'変数「Wkb」に、コピー元を記録
'(Workbookなどの「オブジェクト」と総称されるものに値を記録する
' 場合は、先頭に「Set 」をつける必要があります。また、その際は、
' Openメソッドの引数(ここではファイルパス)は「( )」で囲みます)
Set Wkb = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\" & ActiveCell.Offset(i, 0).Range("A1").Value)

'先頭に「Wkb.」をつけて、同ブックの「E1~E500000」であることを
'明示して変数に格納した後、コピー
'(ここではSelectは省略した方が効率的です)
Set Rng = Wkb.Range("E1:E500000")
Rng.Copy

'できればここも「myfile」用の変数を別に用意して、上と同様に
'対象を明示するとともに、Selectは省略した方がよいかと思います。
Workbooks(myfile).Activate
If j = 1 Then
 Range("G3").Select
 Selection.PasteSpecial
ElseIf j = 2 Then
 Range("H3").Select
 Selection.PasteSpecial
ElseIf j = 3 Then
 Range("I3").Select
 Selection.PasteSpecial
ElseIf j = 4 Then
 Range("J3").Select
 Selection.PasteSpecial
End If

'コピー用の選択状態を解除
'(これにより、「クリップボードに~」のメッセージが表示されなくなる
' ので、DisplayAlertsの切り替えが不要になります)
Application.CutCopyMode = False

'コピー元を閉じる
Wkb.Close

'念のため、明示的に変数を初期化してメモリを解放
Set Rng = Nothing
Set Wkb = Nothing


・・・以上です。
    • good
    • 0
この回答へのお礼

ご丁寧にどうも有難う御座いました。
お礼が遅くなってしまって申し訳ありませんでした。
エラーはまだ出てしまうので、他にも原因がありそうですがその頻度は確実に下がりました。

お礼日時:2012/01/31 13:32

件数が非常に多いので気になりますが


このようにすれば比較的非力なPCでも高速に処理しますので大丈夫ではないかと思います。

if j = 1 Then
sheets("Sheet1").Range("E1:E500000").Copy sheets("Sheet2").Range("G3")
DoEvents:doevents:doevents
    • good
    • 0
この回答へのお礼

回答有難う御座います。

提示してくださったように、DoEventsを挟むような処理も試してみましたが、やはりエラーは出てしまうようです。。

お礼日時:2011/12/18 20:36

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


おすすめ情報

このQ&Aを見た人がよく見るQ&A