[已解决]去除空白工作表

张雄友

去除空白工作表，如文件夹1中的，sheet3工作表要去除，
文件夹2中的 sheet2,sheet3 工作表要去除。明明存在，删除不了。

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2015-2-11 21:45

msgbox都不需要，处理文件的时候。

跳转到最佳答案楼层

hwc2ycy

thestr判断纯属多余，代码刚开始时thestr就是empty，你的判断会阻止正确的执行流程。

张雄友

hwc2ycy 发表于 2015-2-11 21:07
thestr判断纯属多余，代码刚开始时thestr就是empty，你的判断会阻止正确的执行流程。

太多 if  了，我搞到头晕，是哪里错了？恳请帮助。谢谢！

hwc2ycy

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

复制代码

hwc2ycy

剩下你于测试当工作簿是3个空白表的情况吧。

hwc2ycy

对于一个variant类型的变量，要判断是否有曾赋值，可以用isempty来测试

张雄友

hwc2ycy 发表于 2015-2-11 21:11

Application.DisplayAlerts = False  这句不发挥作用。
当一个工作簿中全部是空白工作表时，会不断出现错误提示对话框的。

张雄友

hwc2ycy 发表于 2015-2-11 21:15
对于一个variant类型的变量，要判断是否有曾赋值，可以用isempty来测试

http://www.excelpx.com/thread-339039-1-1.html

对于同样是遍历，黄色单元的整行怎么删除不了，是哪个循环用错了还是此方法行不通？

hwc2ycy

张雄友 发表于 2015-2-11 21:15
Application.DisplayAlerts = False  这句不发挥作用。
当一个工作簿中全部是空白工作表时，会不断出现错 ...

这个提示不需要了，既然都删除得差不多了。
再说这个属性对msgbox是无效的。

张雄友

hwc2ycy 发表于 2015-2-11 21:19
这个提示不需要了，既然都删除得差不多了。
再说这个属性对msgbox是无效的。

http://www.excelpx.com/thread-339039-1-1.html