尝试删除除特定纸张以外的所有纸张时出错

时间:2019-04-01 06:06:25

标签: excel vba

我想删除工作簿中给定年份的月末工作表以外的所有工作表,例如工作表名称的所有工作表名称都以dd.mm.yy格式输入 我尝试了诸如case而不是If的其他代码,但是所有代码似乎都停止在ws.delete

Sub Delete_Sheets
    Yr = InputBox("Use YY format only.", "Which year to keep?", 18)

    Dim ws As Worksheet

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "31.01.Yr" Or ws.Name <> "28.02.Yr" Or ws.Name <> "31.03.Yr" Or ws.Name <> "30.04.Yr" Or ws.Name <> "31.05.Yr" Or ws.Name <> "30.06.Yr" Or ws.Name <> "31.07.Yr" Or ws.Name <> "31.08.Yr" Or ws.Name <> "30.09.Yr" Or ws.Name <> "31.10.Yr" Or ws.Name <> "30.11.Yr" Or ws.Name <> "31.12.Yr" Then        
            ws.Delete
        End If
    Next

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True    
End Sub

2 个答案:

答案 0 :(得分:3)

  • 仅使用Application.InputBox method而非InputBox。该参数具有一个Type:=1参数,该参数强制用户仅输入数字。

  • 请确保您测试ThisWorkbook.Worksheets.Count > 1,因为您无法删除最后一个工作表。必须至少保留1个工作表。

  • 将所有要跳过的工作表放入数组SkipSheets中,并为您的工作表名称(UBound(Filter(SkipSheets, ws.Name)) > -1)过滤该数组


Option Explicit

Public Sub DeleteSheets()
    Dim InputYear As Variant
    InputYear = Application.InputBox(Prompt:="Use YY format only.", Title:="Which year to keep?", Default:=18, Type:=1)

    If VarType(InputYear) = vbBoolean And InputYear = False Then Exit Sub 'user pressed cancel

    Dim SkipSheets() As Variant
    SkipSheets = Array("31.01." & InputYear, "28.02." & InputYear, "31.03." & InputYear, "30.04." & InputYear, "31.05." & InputYear, "30.06." & InputYear, "31.07." & InputYear, "31.08." & InputYear, "30.09." & InputYear, "31.10." & InputYear, "30.11." & InputYear, "31.12." & InputYear)

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If Not (UBound(Filter(SkipSheets, ws.Name)) > -1) And ThisWorkbook.Worksheets.Count > 1 Then
            ws.Delete
        End If
    Next ws

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

答案 1 :(得分:1)

这是另一种方法。由于您不想删除每个月的最后一天,并且看起来所有工作表都一样:

Option Explicit
Sub Delete_Sheets()

    Dim ws As Worksheet, Month As Date, DontDelete As String, Yr As Integer

StartAgain:
    On Error Resume Next
    Yr = InputBox("Use YY format only.", "Which year to keep?", 18)
    On Error GoTo 0
    If Yr = 0 Then
        MsgBox "You didn't enter a valid value. Please Try Again"
        GoTo StartAgain
    End If

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name Like "??.??.??" And ThisWorkbook.Sheets.Count > 1 Then
            ws.Delete
            GoTo NextSheet
        End If
        Month = DateSerial(Yr, Mid(ws.Name, 4, 2), 1)
        DontDelete = Format(Application.EoMonth(Month, 0), "dd.mm.yy")
        If Not ws.Name = DontDelete Then
            ws.Delete
        End If
NextSheet:
    Next

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

编辑:我已经编辑了一些代码,但不会引发任何错误。现在,它不应该删除它所做的某些工作表。但是不可能出现错误。

这是代码的结果:

Before:

After: