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

张雄友

hwc2ycy 发表于 2015-2-11 21:14
剩下你于测试当工作簿是3个空白表的情况吧。

如果有很多（如100个）空白工作簿，会弹出很多错误对话框的。

hwc2ycy

张雄友 发表于 2015-2-11 21:29
如果有很多（如100个）空白工作簿，会弹出很多错误对话框的。

不报错不就行了，搞得这么纠结，或者在代码完行完成后再集中出一个错误的汇总。

hwc2ycy

既然是指量处理文件，当然不可能中间还来一个对话框需要交互的，这不是与自动化批量处理相背离嘛，难道代码在运行的时候还要人守着不停的点确定。要输出错误，可以用DUBUG或者错误写在代码所在的工作簿里。

张雄友

hwc2ycy 发表于 2015-2-11 21:37
既然是指量处理文件，当然不可能中间还来一个对话框需要交互的，这不是与自动化批量处理相背离嘛，难道代码 ...

    Application.DisplayAlerts = False
    On Error Resume Next

这本来就有的，还是会显示错误对话框。

张雄友

hwc2ycy 发表于 2015-2-11 21:37
既然是指量处理文件，当然不可能中间还来一个对话框需要交互的，这不是与自动化批量处理相背离嘛，难道代码 ...

MsgBox err.Description ' 是这句吗？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？不行哦。还请明示。

1. Sub 删除空白工作表()
   
2. On Error GoTo 100
   
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. 
    
22. ' If theStr <> "" Then
    
23. Application.ShowWindowsInTaskbar = False
    
24. Application.ScreenUpdating = False
    
25. Application.DisplayAlerts = False
    
26. 
    
27. If theStr <> ThisWorkbook.Name Then
    
28. On Error Resume Next
    
29. theStr = GetName(thePath)
    
30. For kk = 0 To UBound(theStr)
    
31. Set theBook = Workbooks.Open(theStr(kk))
    
32. If err.Number = 0 Then
    
33. On Error GoTo 0
    
34. theBookCount = theBookCount + 1
    
35. For Each theSht In theBook.Worksheets
    
36. If WorksheetFunction.CountA(theSht.Cells) = 0 Then
    
37. theVisibleShtCount = 0
    
38. If theBook.Sheets.Count > 1 Then
    
39. For Each sht In theBook.Sheets
    
40. If sht.Visible = xlSheetVisible Then theVisibleShtCount = theVisibleShtCount + 1
    
41. Next sht
    
42. If theVisibleShtCount > 1 Then
    
43. Application.DisplayAlerts = False
    
44. theSht.Delete
    
45. theShtCount = theShtCount + 1
    
46. Application.DisplayAlerts = True
    
47. Else
    
48. If theSht.Visible = xlSheetVisible Then
    
49. Application.ScreenUpdating = True
    
50. MsgBox "工作簿内须至少含有一张可视工作表" _
    
51. & vbNewLine & vbNewLine & "当前待处理工作簿“" & theBook.Name & "”的最后一个可视工作表“" & theSht.Name & "”不能被删除！", vbExclamation, "警告"
    
52. Application.ScreenUpdating = False
    
53. End If
    
54. End If
    
55. Else
    
56. Application.ScreenUpdating = True
    
57. MsgBox "工作簿内须至少含有一张可视工作表" _
    
58. & vbNewLine & vbNewLine & "当前待处理工作簿“" & theBook.Name & "”的最后一个可视工作表“" & theSht.Name & "”不能被删除！", vbExclamation, "警告"
    
59. Application.ScreenUpdating = False
    
60. End If
    
61. End If
    
62. Next theSht
    
63. theBook.Close SaveChanges:=True
    
64. Else
    
65. On Error GoTo 0
    
66. Application.ScreenUpdating = True
    
67. MsgBox "打开工作簿" & theStr & "失败！", vbCritical, "错误"
    
68. Application.ScreenUpdating = False
    
69. End If
    
70. Next
    
71. End If
    
72. 
    
73. Application.ScreenUpdating = True
    
74. MsgBox "共计处理 " & theBookCount & " 个工作簿，删除 " & theShtCount & " 个工作表", vbInformation, "提示"
    
75. Application.ShowWindowsInTaskbar = True
    
76. ' Else
    
77. ' Application.ScreenUpdating = True
    
78. ' MsgBox "不存在目标工作簿！", vbInformation, "提示"
    
79. ' End If
    
80. The_Exit:
    
81. Application.ScreenUpdating = True
    
82. Application.ShowWindowsInTaskbar = True
    
83. 
    
84. 100:
    
85. Application.ScreenUpdating = True
    
86. MsgBox err.Description ' 是这句吗？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？？不行哦。
    
87. 
    
88. Set theBook = Nothing
    
89. End Sub

复制代码

hwc2ycy

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

张雄友

hwc2ycy 发表于 2015-2-11 21:45
msgbox都不需要，处理文件的时候。

全部注释掉还是会弹出对话框的。

Sub 删除空白工作表()
    Dim thePath$, theBook As Workbook, sht As Object
    Dim theVisibleShtCount&, theSht As Worksheet, theStr
    Dim theBookCount&, theShtCount&
    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        If .Show = -1 Then
            thePath = .SelectedItems(1)
            If Right(thePath, 1) <> "\" Then thePath = thePath & "\"
        Else
            If MsgBox("以本工作簿所在路径为默认文件夹吗？" _
                    & vbNewLine & vbNewLine & "单击“否”可退出程序", vbYesNo, "确认默认路径") = vbYes Then
                thePath = ThisWorkbook.Path
                If Right(thePath, 1) <> "\" Then thePath = thePath & "\"
            Else
                GoTo The_Exit
            End If
        End If
    End With
    '    If theStr <> "" Then
    Application.ShowWindowsInTaskbar = False
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    If theStr <> ThisWorkbook.Name Then
        On Error Resume Next
        theStr = GetName(thePath)
        For kk = 0 To UBound(theStr)
            Set theBook = Workbooks.Open(theStr(kk))
            If err.Number = 0 Then
                On Error GoTo 0
                theBookCount = theBookCount + 1
                For Each theSht In theBook.Worksheets
                    If WorksheetFunction.CountA(theSht.Cells) = 0 Then
                        theVisibleShtCount = 0
                        If theBook.Sheets.Count > 1 Then
                            For Each sht In theBook.Sheets
                                If sht.Visible = xlSheetVisible Then theVisibleShtCount = theVisibleShtCount + 1
                            Next sht
                            If theVisibleShtCount > 1 Then
                                Application.DisplayAlerts = False
                                theSht.Delete
                                theShtCount = theShtCount + 1
                                Application.DisplayAlerts = True
                            Else
                                If theSht.Visible = xlSheetVisible Then
                                    Application.ScreenUpdating = True
                                    'MsgBox "工作簿内须至少含有一张可视工作表" _
                                         & vbNewLine & vbNewLine & "当前待处理工作簿“" & theBook.Name & "”的最后一个可视工作表“" & theSht.Name & "”不能被删除！", vbExclamation, "警告"
                                    Application.ScreenUpdating = False
                                End If
                            End If
                        Else
                            Application.ScreenUpdating = True
                            'MsgBox "工作簿内须至少含有一张可视工作表" _
                                 & vbNewLine & vbNewLine & "当前待处理工作簿“" & theBook.Name & "”的最后一个可视工作表“" & theSht.Name & "”不能被删除！", vbExclamation, "警告"
                            Application.ScreenUpdating = False
                        End If
                    End If
                Next theSht
                theBook.Close SaveChanges:=True
            Else
                On Error GoTo 0
                Application.ScreenUpdating = True
                'MsgBox "打开工作簿" & theStr & "失败！", vbCritical, "错误"
                Application.ScreenUpdating = False
            End If
        Next
    End If
    Application.ScreenUpdating = True
    'MsgBox "共计处理 " & theBookCount & " 个工作簿，删除 " & theShtCount & " 个工作表", vbInformation, "提示"
    Application.ShowWindowsInTaskbar = True
    '    Else
    '        Application.ScreenUpdating = True
    '        'MsgBox "不存在目标工作簿！", vbInformation, "提示"
    '    End If
The_Exit:
    Application.ScreenUpdating = True
    Application.ShowWindowsInTaskbar = True
    Set theBook = Nothing
End Sub

张雄友

hwc2ycy 发表于 2015-2-11 21:45
msgbox都不需要，处理文件的时候。

http://www.excelpx.com/thread-339039-1-1.html
文件夹1下的工作簿，黄色单元格的行（空行）怎么删除错误？