删除指定表

ykcbf1100

参与一下，附件供参考。。。

ykcbf1100

指定表删除。

1. Sub ykcbf()  '//2025.1.28
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     p = ThisWorkbook.Path & ""
   
6.     On Error Resume Next
   
7.     Dim tm: tm = Timer
   
8.     For Each f In fso.GetFolder(p).Files
   
9.         If LCase$(f.Name) Like "*.xls*" Then
   
10.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
    
11.                 Set wb = Workbooks.Open(f, 0)
    
12.                 For Each sht In wb.Sheets
    
13.                     If InStr(sht.Name, "表样说明") Then sht.Delete
    
14.                 Next
    
15.                 wb.Close 1
    
16.             End If
    
17.         End If
    
18.     Next
    
19.     Application.ScreenUpdating = True
    
20.     Application.DisplayAlerts = True
    
21.     MsgBox "共用时：" & Format(Timer - tm, "0.00") & "秒！"
    
22. End Sub
    

复制代码

gwjkkkkk

ddz79101 发表于 2025-1-28 10:20
老师！我就想如你所说：“通过选择文件方式进行选中后进行操作”，代码如何修改

请参考。。。

ddz79101

ykcbf1100 发表于 2025-1-28 10:30
参与一下，附件供参考。。。

谢谢老师！运行成功！只是若能用选择文件的方法，而不是用同文件夹则更好

ddz79101

gwjkkkkk 发表于 2025-1-28 11:01
请参考。。。

谢谢老师！运行成功

ykcbf1100

ddz79101 发表于 2025-1-28 12:09
谢谢老师！运行成功！只是若能用选择文件的方法，而不是用同文件夹则更好

改一下，选择单个或多个文件删除

注意：如果选择多个文件时，先按住Ctrl键，再点选文件。

ykcbf1100

选择文件删除

1. Sub ykcbf()  '//2025.1.28  选择文件删除
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Set fso = CreateObject("Scripting.FileSystemObject")
   
5.     p = ThisWorkbook.Path & ""
   
6.     On Error Resume Next
   
7.     Dim tm: tm = Timer
   
8.     With Application.FileDialog(msoFileDialogFilePicker)
   
9.         .Title = "请选择文件夹"
   
10.         .InitialFileName = ThisWorkbook.Path & ""
    
11.         .AllowMultiSelect = True
    
12.         .Filters.Clear
    
13.         .Filters.Add "Excel Files", "*.xls?"
    
14.         .Filters.Add "All Files", "*.*"
    
15.         If .Show Then Set fns = .SelectedItems Else Exit Sub
    
16.     End With
    
17.     For Each f In fns
    
18.         Set wb = Workbooks.Open(f, 0)
    
19.         For Each sht In wb.Sheets
    
20.             If InStr(sht.Name, "表样说明") Then sht.Delete
    
21.         Next
    
22.         wb.Close 1
    
23.     Next
    
24.     Application.ScreenUpdating = True
    
25.     Application.DisplayAlerts = True
    
26.     MsgBox "共用时：" & Format(Timer - tm, "0.00") & "秒！"
    
27. End Sub
    

复制代码

ddz79101

ykcbf1100 发表于 2025-1-28 12:17
改一下，选择单个或多个文件删除

注意：如果选择多个文件时，先按住Ctrl键，再点选文件。

谢谢老师！运行成功

ddz79101

ddz79101 发表于 2025-1-28 12:09
谢谢老师！运行成功！只是若能用选择文件的方法，而不是用同文件夹则更好

祝老师：春节快乐，身体健康！

ddz79101

ykcbf1100 发表于 2025-1-28 12:17
改一下，选择单个或多个文件删除

注意：如果选择多个文件时，先按住Ctrl键，再点选文件。

祝老师：春节快乐，身体健康！