複数のワークシートを高速で削除する方法

Question

複数のワークシートを持つワークブックがありますが、そのほとんどは特定のマクロを実行するたびに削除されます。削除するワークシートの数は、1〜150の範囲で変化します。

現在、以下のマクロのセクションでは、78のワークシートを削除するのに約215秒かかります。それを速くする方法はありますか？同様の数のワークシートに対して60秒未満のランタイム？

For Each WrkSh In MainFile.Worksheets 
    If WrkSh.Index > 5 Then 
    WrkSh.Delete 
    End If 
Next WrkSh 


MainFile.Sheets("Input").Unprotect 
MainFile.Sheets("Buyers").Unprotect 
MainFile.Sheets("Template").Visible = True 
MainFile.Sheets("Holidays").Visible = True 


With MainFile.Sheets("Input") 
    .Range("A10:A200").ClearContents 
    .Range("E11:N200").Clear 
End With 

With MainFile.Sheets("Buyers") 
    .Range("A10:B40").ClearContents 
    .Range("C11:J40").Clear 
End With 

EDIT：

は、ここでは、コードの該当部分である私は、メインコードの先頭でこのApplication.ScreenUpdating = Falseを持っています。

Answer 1

オプション1 シートをグループ化してグループとして削除できます。それはもっと速いかもしれません。それをテストすることができます。

Dim arrDelete() As String 
ReDim arrDelete(MainFile.Worksheets.Count) 

Dim index As Long 
For Each WrkSh In MainFile.Worksheets 
    If WrkSh.index > 5 Then 
     arrDelete(index) = WrkSh.Name 
     index = index + 1 
    End If 
Next WrkSh 

ReDim Preserve arrDelete(index - 1) 

Application.DisplayAlerts = False 
MainFile.Sheets(arrDelete).Delete 
Application.DisplayAlerts = True 

OPTION 2 残したいシートの外側のリンクがない場合は、新しいワークブックにそれらのシートをコピーして、古いワークブックを削除することができます。これはおそらく最も安全な選択肢ではありませんが、状況によっては動作する可能性があります。

Answer 2

Application.ScreenUpdating = Falseをお使いですか？

Answer 3

問題の原因となっているコードの部分は本当ですか？私はあなたの状況をすばやく再現し、ほとんど瞬時に実行されます。

Answer 4

Sub test() 
    Dim a(), sh As Worksheet 

    ReDim a(1 To Sheets.Count - 5) 
    For Each sh In ThisWorkbook.Sheets 
     If sh.Index > 5 Then a(sh.Index - 5) = sh.Name 
    Next sh 

    Sheets(a).Delete 
End Sub