含指定文本的工作表删除VBA代码失效问题求助

问题 #

我编写了一段VBA代码，想要删除活动工作簿中名称包含指定文本的所有工作表，但代码完全无法生效——输入无前后空格的指定文本后，宏运行结果提示删除了0个工作表。

使用的代码如下：

Private Sub CommandButton28_Click()

   Dim shName As String
   Dim xName As String
   Dim xWs As Worksheet
   Dim cnt As Integer
   shName = Application.InputBox("Enter the specific text:", "Delete sheets", _
                                   ThisWorkbook.ActiveSheet.Name, , , , , 2)
   If shName = "" Then Exit Sub
   xName = "*" & shName & "*"
'    MsgBox xName
   Application.DisplayAlerts = False
   cnt = 0
   For Each xWs In ThisWorkbook.Sheets
       If xWs.Name Like xName Then
           xWs.Delete
           cnt = cnt + 1
       End If
   Next xWs
   Application.DisplayAlerts = True
   MsgBox "Have deleted " & cnt & " worksheets", vbInformation, "Sheets removed"

End Sub

测试场景：工作表名称包含Sheet1 (2)、Sheet1 (3)、Sheet2等，输入"Sheet1"后，宏运行提示删除0个工作表。

修复方案 #

问题根源 #

使用For Each遍历ThisWorkbook.Sheets集合时，直接删除工作表会破坏集合的遍历结构，导致部分符合条件的工作表被跳过，最终出现删除计数为0的异常。

解决方法 #

以下两种方式均可可靠实现需求：

方法1：反向索引遍历工作表

从最后一个工作表开始往前遍历，避免删除操作导致的索引错位：

Private Sub CommandButton28_Click()
    Dim shName As String
    Dim xName As String
    Dim cnt As Integer
    Dim i As Integer
    
    shName = Application.InputBox("请输入指定文本:", "删除工作表", _
                                   ThisWorkbook.ActiveSheet.Name, , , , , 2)
    If shName = "" Then Exit Sub
    xName = "*" & shName & "*"
    
    Application.DisplayAlerts = False
    cnt = 0
    ' 从最后一个工作表反向遍历，避免索引错位
    For i = ThisWorkbook.Sheets.Count To 1 Step -1
        If ThisWorkbook.Sheets(i).Name Like xName Then
            ThisWorkbook.Sheets(i).Delete
            cnt = cnt + 1
        End If
    Next i
    Application.DisplayAlerts = True
    
    MsgBox "已删除 " & cnt & " 个工作表", vbInformation, "删除完成"
End Sub

方法2：先收集待删除工作表再批量删除

将符合条件的工作表存入集合，之后统一删除，避免遍历原集合时修改其结构：

Private Sub CommandButton28_Click()
    Dim shName As String
    Dim xName As String
    Dim xWs As Worksheet
    Dim cnt As Integer
    Dim delSheets As New Collection
    
    shName = Application.InputBox("请输入指定文本:", "删除工作表", _
                                   ThisWorkbook.ActiveSheet.Name, , , , , 2)
    If shName = "" Then Exit Sub
    xName = "*" & shName & "*"
    
    ' 先收集所有符合条件的工作表
    For Each xWs In ThisWorkbook.Sheets
        If xWs.Name Like xName Then
            delSheets.Add xWs
        End If
    Next xWs
    
    Application.DisplayAlerts = False
    cnt = 0
    ' 批量删除收集到的工作表
    For Each xWs In delSheets
        xWs.Delete
        cnt = cnt + 1
    Next xWs
    Application.DisplayAlerts = True
    
    MsgBox "已删除 " & cnt & " 个工作表", vbInformation, "删除完成"
End Sub

额外说明 #

• 两种方法均可解决原代码的遍历异常问题，确保所有符合条件的工作表被正确删除
• 注意：Excel工作簿至少需要保留一个可见工作表，否则删除操作会报错，若需处理极端场景，可额外添加判断逻辑

内容的提问来源于stack exchange，提问作者Pom