尝试删除除特定工作表之外的所有工作表时出错

Question

我想删除工作簿中的所有工作表，给定年份的月末工作表除外，例如工作表名称所有工作表名称都以这种格式输入 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

Answer 1

• 仅使用 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

Answer 2

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

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

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

这是代码的结果：