更快的方法删除多个工作表

我有一个工作簿与多个工作表，其中大多数是每次我运行一个特定的macros时被删除。 要删除的工作表数量在1到150之间变化。

目前macros下面的部分大约需要215秒来删除78个工作表。 有什么办法可以让它更快？ 对于相似数量的工作表，less于60s的运行时间？

这是代码的相关部分：

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 

编辑：我有这个Application.ScreenUpdating = False在主代码的开始。

Answer 1

选项1您可以将工作表分组并将其作为一个组删除。 这可能会更快; 你可以testing它。

 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 

选项2如果您要保留的工作表之外没有链接，可以将这些工作表复制到新的工作簿并删除旧的工作簿。 这可能不是最安全的select，但可能在某些情况下工作。

Answer 2

你在使用Application.ScreenUpdating = False吗？

Answer 3

你确定这是你的代码的一部分导致问题？ 我很快重新创build了你的情况，并且几乎立即运行。

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