Ошибка при попытке удалить все листы, кроме определенных

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 вместо 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

Редактировать: я отредактировал некоторый код, но он не может выдать ошибку.Теперь он не должен удалять некоторые листы, которые он сделал.Но вы никак не можете получить сообщение об ошибке.

Вот результат кода: