Excel VBA質問箱 IV

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

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


20116 / 76732 ←次へ | 前へ→

【62039】Re:シート追加・削除の繰り返しで例外発生
発言  りん E-MAIL  - 09/6/18(木) 10:07 -

引用なし
パスワード
   新田 哲二 さん、こんにちわ。

>Excel2003で動かしている処理において例外エラーは発生するため、問題の所在を確認するためにその処理ロジックだけを抜き出して(以下)動作させましたところ、Excel2003では約5000回、Excel2007では10,700近辺で例外が発生します。一回も完了を経験していません。使用しているPCのいずれにおいてもほぼ同じポイントで発生します
>何かシステムリソースを消費しているのか、制限事項があるのか分かりません。どなたか、回避方法をご存知に方がありましたら教えていただきたいのですが。

ちょっと加工して、こういうマクロでテスト(ステータスバーにログを表示)しました。環境はWinXP & XL2003SP3です。

Sub Sheet_Add_Del_Loop()
  Dim Count As Integer, ws As Worksheet
  Dim シート名 As String
  Count = 1
 
  With Application
   .DisplayAlerts = False
   .ScreenUpdating = False
   Do While Count <= 12000
     On Error GoTo エラー処理
     With .ActiveWorkbook
       Set ws = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count)) 'シートを最後のシートの後へ挿入
     End With
     s1 = Count & " " & ws.Cells(Count).Address(0, 0, external:=True)
     .StatusBar = s1
     ws.Delete
     Set ws = Nothing
     ' +1
     Count = Count + 1
   Loop
   .DisplayAlerts = True
   .ScreenUpdating = True
   .StatusBar = False
  End With
  MsgBox s1, vbInformation, "完了"
Exit Sub
'
エラー処理:
  MsgBox "Err" & Count, vbCritical, Error(Err)
  On Error GoTo 0
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
  Application.StatusBar = False
  MsgBox s1, vbExclamation, "中断"
End Sub

以下、実験結果。
VBEを起動して、
 VBEから直接実行 × 5850回前後で終了(エラー終了)
 VBEを後ろに隠してワークシートメニューバーのツール→マクロ × 上と同様

VBEを起動せずに、
 ワークシートメニューバーのツール→マクロ ○ 無事に完了
 シートにボタンを置いて、マクロを登録しクリックして実行 ○ 無事に完了
 ツールバーにコマンドボタンを配置しマクロを登録して実行 ○ 無事に完了

というわけで上のマクロだと、VBEを起動せずに実行するとエラーになりませんでした。VBEを起動しているとステータスバーへのログの表示が遅くなる(3桁目が簡単に読めるようになる)のでここでかなり負荷がかかってる気がします。
74 hits

【61989】シート追加・削除の繰り返しで例外発生 新田 哲二 09/6/16(火) 8:45 質問
【62002】Re:シート追加・削除の繰り返しで例外発生 リノ 09/6/16(火) 16:00 発言
【62004】Re:シート追加・削除の繰り返しで例外発生 リノ 09/6/16(火) 16:06 発言
【62039】Re:シート追加・削除の繰り返しで例外発生 りん 09/6/18(木) 10:07 発言

20116 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free