Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

4603 / 76807

←次へ　｜　前へ→


	【77825】メモリ不足の解消の仕方

YUKI - 16/1/6(水) 15:43 -


	引用なし

	パスワード

いつもお世話になっております。解決策をご教授くださいませ。

シート16-30のデータをオートフィルターを使用してH行でソート、
ソートしたデータをシート1-15へデータを貼り付ける
（シート16はシート1、シート17はシート2へと順番に）
全部の記述を長いマクロで書いていた時は動いていたのですが、
繰り返しのマクロを使用して可読性を向上させようとしたところ
途中でメモリ不足になってしまうようになりました。
エラーで止まってしまうところまでは上手く動いているのですが･･･
手探りでネットを探して、見よう見まねで
DoEvents
Erase DynamicArray
の構文を入れてみましたが改善されず。お助けください･･･

Sub 貼り付け()
'
'
'
　　Application.ScreenUpdating = False
　　On Error Resume Next
　　
　　Dim i As Integer
　　　　
　　For i = 16 To 30
　　
　　
　　'
　　'
　　'3
　　Sheets(i).Select
　　Rows("41:41").Select
　　Selection.AutoFilter
　　Range("A41").CurrentRegion.AutoFilter Field:=8, Criteria1:="3"
　　Range("A41:F41").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy
　　Sheets(i - 15).Select
　　Range("A35").PasteSpecial Paste:=xlPasteValues
　　'
　　'4
　　Sheets(i).Select
　　Rows("41:41").Select
　　Selection.AutoFilter
　　ActiveSheet.Range("$A$41:$H$5000").AutoFilter Field:=8, Criteria1:="4"
　　Range("A41:F41").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy
　　Sheets(i - 15).Select
　　Range("Q35").PasteSpecial Paste:=xlPasteValues
　　'
　　'5
　　Sheets(i).Select
　　Rows("41:41").Select
　　Selection.AutoFilter
　　ActiveSheet.Range("$A$41:$H$5000").AutoFilter Field:=8, Criteria1:="5"
　　Range("A41:F41").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy
　　Sheets(i - 15).Select
　　'
　　'6
　　Sheets(i).Select
　　Rows("41:41").Select
　　Selection.AutoFilter
　　ActiveSheet.Range("$A$41:$H$5000").AutoFilter Field:=8, Criteria1:="6"
　　Range("A41:F41").Select
　　Range(Selection, Selection.End(xlDown)).Select
　　Selection.Copy
　　Sheets(i - 15).Select
　　'
　　'
　　'
　　'
　　Range("A32").Select
　　Sheets(i).Select
　　Rows("41:41").Select
　　Selection.AutoFilter
　　Range("A42").Select
　　DoEvents
　　Next
　　'
　　'
　　Erase DynamicArray
　　Sheets(16).Select
　　Application.ScreenUpdating = True

1 hits

▼

【77825】メモリ不足の解消の仕方 YUKI 16/1/6(水) 15:43