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

张雄友

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

maditate

大循环，打开指定文件夹中的文件
内循环，检查文件中的每个工作表。
判断工作表上是否存在非空单元格
不存在则删除，关闭
关闭文件。

张雄友

maditate 发表于 2013-6-15 22:06
大循环，打开指定文件夹中的文件
内循环，检查文件中的每个工作表。
判断工作表上是否存在非空单元格

能来点直接的代码供测试？

maditate

张雄友 发表于 2013-6-15 22:09
能来点直接的代码供测试？

给你代码你会永远长不大。

张雄友

教学相长，永不过时。

张雄友

maditate 发表于 2013-6-15 22:11
给你代码你会永远长不大。

功力不够深厚，编写了一个，出错。

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
    

复制代码

maditate

张雄友 发表于 2013-6-15 22:21
功力不够深厚，编写了一个，出错。

Sub 查空表()
For Each myS In ThisWorkbook.Sheets
aa = Application.CountA(myS.Cells)
If aa = 0 Then
  MsgBox myS.Name & "工作表为空表"
Else
  MsgBox myS.Name & "工作表有 " & aa & "  个单元格有值"

End If

Next
End Sub

张雄友

maditate 发表于 2013-6-15 22:36
Sub 查空表()
For Each myS In ThisWorkbook.Sheets
aa = Application.CountA(myS.Cells)

与要求不符合。

maditate

张雄友 发表于 2013-6-15 22:38
与要求不符合。

没有按一楼的要求写代码，只不过给你查空表的例子。

yygpdkkk

－－－－－－－－－－－－－－－

1. 
   
2. Sub 遍历文件夹删除空白工作表()
   
3.     Dim thePath$, theBook As Workbook, sht As Object
   
4.     Dim theVisibleShtCount&, theSht As Worksheet, theStr$
   
5.     Dim theBookCount&, theShtCount&
   
6.     With Application.FileDialog(msoFileDialogFolderPicker)
   
7.         .AllowMultiSelect = False
   
8.         If .Show = -1 Then
   
9.             thePath = .SelectedItems(1)
   
10.             If Right(thePath, 1) <> "" Then thePath = thePath & ""
    
11.         Else
    
12.             If MsgBox("以本工作簿所在路径为默认文件夹吗？" _
    
13.             & vbNewLine & vbNewLine & "单击“否”可退出程序", vbYesNo, "确认默认路径") = vbYes Then
    
14.                 thePath = ThisWorkbook.Path
    
15.                 If Right(thePath, 1) <> "" Then thePath = thePath & ""
    
16.             Else
    
17.                 GoTo The_Exit
    
18.             End If
    
19.         End If
    
20.     End With
    
21.     theStr = Dir(thePath & "*.xls")
    
22.     If theStr <> "" Then
    
23.         Application.ShowWindowsInTaskbar = False
    
24.         Do
    
25.             Application.ScreenUpdating = False
    
26.             If theStr <> ThisWorkbook.Name Then
    
27.                 On Error Resume Next
    
28.                 Set theBook = Workbooks.Open(thePath & theStr)
    
29.                 If Err.Number = 0 Then
    
30.                     On Error GoTo 0
    
31.                     theBookCount = theBookCount + 1
    
32.                     For Each theSht In theBook.Worksheets
    
33.                         If WorksheetFunction.CountA(theSht.Cells) = 0 Then
    
34.                             theVisibleShtCount = 0
    
35.                             If theBook.Sheets.Count > 1 Then
    
36.                                 For Each sht In theBook.Sheets
    
37.                                     If sht.Visible = xlSheetVisible Then theVisibleShtCount = theVisibleShtCount + 1
    
38.                                 Next sht
    
39.                                 If theVisibleShtCount > 1 Then
    
40.                                     Application.DisplayAlerts = False
    
41.                                     theSht.Delete
    
42.                                     theShtCount = theShtCount + 1
    
43.                                     Application.DisplayAlerts = True
    
44.                                 Else
    
45.                                     If theSht.Visible = xlSheetVisible Then
    
46.                                         Application.ScreenUpdating = True
    
47.                                         MsgBox "工作簿内须至少含有一张可视工作表" _
    
48.                                         & vbNewLine & vbNewLine & "当前待处理工作簿“" & theBook.Name & "”的最后一个可视工作表“" & theSht.Name & "”不能被删除！", vbExclamation, "警告"
    
49.                                         Application.ScreenUpdating = False
    
50.                                     End If
    
51.                                 End If
    
52.                             Else
    
53.                                 Application.ScreenUpdating = True
    
54.                                 MsgBox "工作簿内须至少含有一张可视工作表" _
    
55.                                 & vbNewLine & vbNewLine & "当前待处理工作簿“" & theBook.Name & "”的最后一个可视工作表“" & theSht.Name & "”不能被删除！", vbExclamation, "警告"
    
56.                                 Application.ScreenUpdating = False
    
57.                             End If
    
58.                         End If
    
59.                     Next theSht
    
60.                     theBook.Close SaveChanges:=True
    
61.                 Else
    
62.                     On Error GoTo 0
    
63.                     Application.ScreenUpdating = True
    
64.                     MsgBox "打开工作簿" & theStr & "失败！", vbCritical, "错误"
    
65.                     Application.ScreenUpdating = False
    
66.                 End If
    
67.             End If
    
68.             theStr = Dir
    
69.         Loop Until theStr = ""
    
70.         Application.ScreenUpdating = True
    
71.         MsgBox "共计处理 " & theBookCount & " 个工作簿，删除 " & theShtCount & " 个工作表", vbInformation, "提示"
    
72.         Application.ShowWindowsInTaskbar = True
    
73.     Else
    
74.         Application.ScreenUpdating = True
    
75.         MsgBox "不存在目标工作簿！", vbInformation, "提示"
    
76.     End If
    
77. The_Exit:
    
78.     Application.ScreenUpdating = True
    
79.     Application.ShowWindowsInTaskbar = True
    
80.     Set theBook = Nothing
    
81. End Sub
    
82. 
    

复制代码