使用VBA删除所有工作表，直到给定的一组名称

Question

我想删除当前工作簿中的所有工作表，例外{A2，A3，...}中的列表和名称为Summary的工作表。 我写了以下代码

Dim MyCell As Range, MyRange As Range


    Set MyRange = Sheets("Summary").Range("A2")
    Set MyRange = Range(MyRange, MyRange.End(xlDown))

 Application.ScreenUpdating = False
 Application.DisplayAlerts = False

  Set wbook = ActiveWorkbook
    For Each xWs In wbook.Worksheets
     For Each MyCell In MyRange
        If xWs.Name <> MyCell.Value And xWs.Name <> "Summary" Then
            xWs.Delete
        End If
    Next MyCell
Next
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

但我得到一个运行时错误，我不知道它是什么。 然后，我尝试逐行运行：在“xWs.Name = Summary”的第一个循环中，第一个表格没有问题我在

时遇到错误

If xWs.Name <> MyCell.Value And xWs.Name <> "Summary" Then

我知道这段代码根本不高效，因为如果名称匹配，它仍然会一直运行到名称集的末尾。但是，我不知道如何以有效的方式比较VBA中的拖曳组。 可以在中看到A列中的名称列表。

Answer 1

你需要稍微接近它，你需要循环遍历每张表格上的范围，一旦你有匹配你需要举起一个标志而不是删除这张表格。 请尝试以下代码：

Sub DeleteSelectedSheets()

Dim MyCell As Range, MyRange As Range
Dim wbook As Workbook, xWs As Worksheet
Dim DeleteSheetFlag As Boolean

Set MyRange = Sheets("Summary").Range("A2")
Set MyRange = Range(MyRange, MyRange.End(xlDown))

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Set wbook = ActiveWorkbook

For Each xWs In wbook.Worksheets
    DeleteSheetFlag = True

    For Each MyCell In MyRange
        Select Case xWs.Name

            Case MyCell.Value, "Summary"
                DeleteSheetFlag = False
                Exit For

        End Select

    Next MyCell

    If DeleteSheetFlag Then
        xWs.Delete
    End If

Next xWs

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub