Question

我有一个包含多个工作表的工作簿，每次运行特定宏时都会删除大多数工作表。要删除的工作表数量从1到150不等。

目前，下面的宏部分大约需要215秒才能删除78个工作表。有没有办法让它更快？对于类似数量的工作表，运行时间不到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

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

Answer 1

您使用的是Application.ScreenUpdating = False吗？

Answer 2

您确定代码中的那部分导致问题吗？我很快就重建了你的情况，它几乎立刻就会运行。

Answer 3

选项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

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

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

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

4 个答案: