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

我想删除当前工作簿中的所有工作表，例如{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