批量删除工作簿指定的工作表可以吗？

再回首-沉默

比如批量删除带有    （2）   的所有工作表，表多的情况，手删太久了，网上没有找到合适的代码

半百

ynzsvt

1. Sub mydelete2sheet()
   
2. Dim Sh As Worksheet
   
3. Application.DisplayAlerts = False '不警告就删除
   
4. For Each Sh In Worksheets
   
5.   If Sh.Name Like "*(2)" Then Sh.Delete
   
6. Next
   
7. Application.DisplayAlerts = True
   
8. End Sub

复制代码

ynzsvt

1. Sub mydelete2sheet()
   
2. Dim Sh As Worksheet
   
3. ' Application.DisplayAlerts = False '不警告就删除
   
4. For Each Sh In Worksheets
   
5.   If Sh.Name Like "*([2345])" Then
   
6.    Sh.Activate
   
7.    Sh.Delete
   
8.   End If
   
9. Next
   
10. Application.DisplayAlerts = True
    
11. End Sub

复制代码

这样的话，删除前可以确认。

feilanga

这样吗...........

feilanga

1. Sub 批量删除()
   
2.     arr = Sheet1.Range("a1").CurrentRegion
   
3.     Dim dic As Object
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     For i = 2 To UBound(arr)
   
6.         dic(arr(i, 1)) = ""
   
7.     Next
   
8.     Application.DisplayAlerts = False   '不显示警告框
   
9.     Dim r As Worksheet
   
10.     For Each r In Sheets
    
11.         If r.Name <> "参数" Then
    
12.             s = r.Name & ""
    
13.             dkey = getKey(s, dic)
    
14.             If dkey <> "" Then
    
15.                 r.Delete
    
16.             End If
    
17.         End If
    
18.     Next
    
19.     Application.DisplayAlerts = True    '恢复显示警告框
    
20.     MsgBox "批量删除完毕"
    
21. End Sub
    
22. Function getKey(strWhole, dic As Object) As String
    
23.     Dim key
    
24.     getKey = ""
    
25.     For Each key In dic.keys
    
26.         If InStr(strWhole, key) > 0 Then
    
27.             getKey = key
    
28.             Exit Function
    
29.         End If
    
30.     Next
    
31. End Function

复制代码