VBA学习(9)：按指定名单一键删除工作表

今天继续给大家聊VBA编程中工作表对象的常用操作，主要内容是如何批量删除工作表；也就是删除单个工作表、删除全部工作表和删除指定名单内的工作表。

1.删除单个工作表

删除工作表需要使用到工作表对象的delete方法，语法格式如下：

工作表对象.delete

举个例子，以下代码可以删除当前工作簿的首个工作表。

Sub DelSht()Application.DisplayAlerts = FalseWorksheets(1).DeleteApplication.DisplayAlerts = True
End Sub

删除工作表的动作，会引发系统会弹出一个消息框

第2行代码的作用就是屏蔽此类系统显示的警告和消息，避免程序运行被打断

第4行代码恢复系统显示警告消息的功能。

2.删除全部工作表

以下代码可以删除当前工作簿"全部"的工作表

Sub DelShtAll()Dim sht As WorksheetApplication.DisplayAlerts = FalseFor Each sht In Sheets '集合遍历If sht.Name <> ActiveSheet.Name Thensht.Delete '如果sht的名字不等于当前工作表则删除End IfNextApplication.DisplayAlerts = True
End Sub

代码采用集合遍历的方式遍历当前工作簿每一张工作表，如果该工作表不是当前工作表则删除。代码运行后，工作簿就只剩下当前工作表孤零零一个人了。

打个响指，需要说明两点，一个是系统要求工作簿必须存在至少一张可见工作表，因此我们并不能将全部工作表都解雇，上述代码选择了保留当前工作表

另外，删除这个动作是无视工作表是否隐藏的，即便工作表隐藏不可见，也一样会被删掉

3.删除指定名单工作表

如下图所示，需要根据A2:B9单元格区域所提供的名单将相关工作表全部删除。

示例代码如下：

Sub DelShtByCustom()Dim sht As Worksheet, rngData As Range, c As RangeDim d As Object, y As LongDim strName As String, strErr As StringIf ActiveWorkbook.ProtectStructure = True ThenMsgBox "工作簿有保护，需要先撤销保护再运行代码"Exit SubEnd IfOn Error Resume Next '使程序忽略错误继续运行Set rngData = Application.InputBox("请选择需要删除的工作表名单区域", _Title:="公众号Excel星球", _Default:=Selection.Address, _Type:=8)Set rngData = Intersect(rngData, rngData.Parent.UsedRange)If rngData Is Nothing ThenMsgBox "未选择有效数据区域。"Exit SubEnd IfSet d = CreateObject("scripting.dictionary") '后期字典For Each sht In Sheets '遍历工作表名存入字典strName = sht.Named(strName) = ""NextWith Application '取消屏幕刷新、信息警告等.ScreenUpdating = False.DisplayAlerts = False.Calculation = xlCalculationManualEnd WithFor Each c In rngData '遍历名单区域strName = c.ValueIf Len(strName) Then '如果名字非空If d.exists(strName) Then '如果字典中存在删除表名If Sheets.Count > 1 Then '判断工作表个数是否可删Sheets(strName).Delete '删除工作表y = y + 1 '累加个数ElseMsgBox "系统要求工作表必须保留至少一张，因此" & _strName & "未能删除。"End IfElse '如果不存在删除表名strErr = strErr & "," & strName '合并不存在的表名End IfEnd IfNextWith Application '恢复屏幕刷新、信息警告等.ScreenUpdating = True.DisplayAlerts = True.Calculation = xlCalculationAutomaticEnd WithIf strErr <> "" ThenMsgBox "以下名称工作簿中不存在工作表，未能删除：" & vbCrLf _& Mid(strErr, 2)ElseMsgBox "处理完成。"End IfSet d = Nothing
End Sub

代码详细解释见注释，概要总结如下：

第5至第8行代码判断工作簿是否有保护，工作簿结构保护状态下，工作表是不被允许开除的，违法行为知道吧？

第9行代码使程序忽视错误继续运行。

第10至第18行代码使用Application.InputBox语句允许户选择删除名单的区域，并判断该区域是否有效。

第19至第23行代码将当前工作簿现有工作表的名字存入字典。

第24至第28行代码取消屏幕刷新、警告消息框、公式重算等。

第29至第44行代码遍历名单数据，第32行代码判断字典中是否存在需要删除的表名，如果存在，则删除，否则使用变量strErr记录未能删除的名单。

第45至第49行代码恢复屏幕刷新、警告消息框、公式重算等。

第50至第55行代码使用Msgbox语句显示处理结果相关信息。

技术交流，软件开发，欢迎加微信xwlink1996