[已解决]删除指定文件夹中所有工作簿中的空白工作表

张雄友

如何删除指定文件夹中所有工作簿中的空白工作表。

最佳答案

月排行榜 / 总排行榜

殿堂之上

2013-6-16 01:00

你看下是不是这样，将要清的文件夹中工作簿全选上

跳转到最佳答案楼层

张雄友

1. Sub text()
   
2. Application.ScreenUpdating = False
   
3. Dim sh As Worksheet
   
4. For Each sh In ThisWorkbook.Worksheets
   
5. If sh Is Empty Then
   
6. sh.Delete
   
7. End If
   
8. Next
   
9. Application.ScreenUpdating = True
   
10. End Sub
    

复制代码

张雄友

这个不行的。

殿堂之上

你看下是不是这样，将要清的文件夹中工作簿全选上

张雄友

殿堂之上 发表于 2013-6-16 01:00
你看下是不是这样，将要清的文件夹中工作簿全选上

发现有个BUG，就是当工作簿中有隐藏工作表时，会出错。如附件中隐藏了sheet12,sheet11,sheet10，执行代码会出错。
而且附件中的工作簿打不开了，要打开，就要先打开其它工作簿后，再可以打开，我已经测试过二次是这样的。

妞叫七七

Sub ql()
Dim myApp As New Application
Dim sh As Worksheet
Dim wk As Workbook
Set dig = Application.FileDialog(msoFileDialogFilePicker)
With dig
.AllowMultiSelect = True
.Filters.Add "Excel文件", "*.xls", 1
.InitialFileName = ThisWorkbook.Path
.InitialView = msoFileDialogViewDetails
.Title = "打开"
If .Show = 0 Then
Exit Sub
End If
End With
For Each f In dig.SelectedItems
Set wk = myApp.Workbooks.Open(f)
For Each sh In wk.Worksheets
If IsEmpty(sh.UsedRange) = True Then
MsgBox 22
   sh.Delete
End If
Next sh
wk.Save
Next f
myApp.Quit
End Sub

张雄友

妞叫七七 发表于 2013-6-16 08:10
Sub ql()
Dim myApp As New Application
Dim sh As Worksheet

MsgBox 22

执行宏后，这个对话框要点好几下的，不知道为什么？

妞叫七七

测试用的,把msgbox 22这行代码删除了吧

guogongyi

妞叫七七 发表于 2013-6-16 08:10
Sub ql()
Dim myApp As New Application
Dim sh As Worksheet

好用的狠

我叫好学

太好了