Как пометить или удалить листы, отсутствующие в списке, с несколькими исключениями - PullRequest
0 голосов
/ 05 марта 2019

Далее выполняется код, выполняющий следующие действия:

  • вкладки цветного листа, если их нет в списке ссылок
  • Уведомление пользователя о спискелисты не были в списке ссылок
  • Удалите листы, которых нет в списке ссылок, в зависимости от ввода пользователя

Sub Audit_Estimate_sheets()
    Dim ws As Worksheet
    Dim wb As Workbook
    Dim ws_List As String
    Dim Delete_Orphans As Integer
    Dim Item_List_Sheet As Worksheet
    Dim Item_List_First_Row As Long
    Dim Item_List_Max_Row As Long

    Set Item_List_Sheet = Sheets(2)

    Item_List_First_Row = 14
    Item_List_Max_Row = Item_List_First_Row + Application.WorksheetFunction.Max(Item_List_Sheet.Range("B:B")) - 1

    Set wb = ActiveWorkbook
    For Each ws In wb.Worksheets
        If IsError(Application.Match(ws.Name, Item_List_Sheet.Range("C" & Item_List_First_Row & ":C" & Item_List_Max_Row), 0)) And ws.Index > 2 Then
            'Colour Tab'
            With ws.Tab
                .ThemeColor = xlThemeColorAccent2
                .TintAndShade = 0
            End With
            'Add name to list
            If ws_List = "" Then
                ws_List = ws.Name
            Else
                ws_List = ws_List & ", " & ws.Name
            End If
        End If
    Next ws

    'display list
    Delete_Orphans = MsgBox("The following estimate sheets were not part of the item list and are currently orphaned:  " & vbLf & vbLf & ws_List & vbLf & vbLf & "Would you like to delete them?", vbYesNo + vbQuestion, "Delete Orphaned Estimates")

    If Delete_Orphans = vbYes Then
        'loop through sheets again and delete
    End If

End Sub

В моей книге есть несколько листов, которыенет в списке литературы, но я не хочу, чтобы они также были удалены.Даже мой подход к тому, чтобы убедиться, что я вышел за пределы листа (2), не обязательно является хорошим подходом, если я понимаю, что если пользователь перетаскивает вкладку не по порядку, его порядковый номер может измениться.Мой простой подход, который заканчивается большим количеством текста, - это ряд, вложенный в операторы

IF ws.name <> exception1 Then
    IF ws.name <> exception2 Then
        IF ws.name <> exception3 Then
            ws.delete
        End If
    End If
End If

Есть ли лучший подход?

1 Ответ

2 голосов
/ 05 марта 2019

Я думаю, что Select Case поможет:

Select Case ws.Name
    Case "exception1", "exception2", "exception3" 'ignore
    Case Else
       ws.Delete 'or whatever other code you want here
End Case

Если ваш список исключений становится длинным, вы также можете написать функцию для проверки имени по списку определенных имен. Это будет легче управлять.

Один пример функции хотел бы это, вкратце:

If Not exception(ws.Name) Then
    ws.Delete 'or whatever other code is needed
End If

Function exception(theSheet as String) as Boolean
'boolean is false by default, so only changing to true if it finds sheet is in exception list

    Dim exceptions(2) as String
    exceptions(0) = "exception1"
    exceptions(1) = "exception2"
    exceptions(2) = "exception3"

    Dim looper as Integer
    For looper = lbound(exceptions) to ubound(exceptions)
        If theSheet = exceptions(looper) Then
            exception = True
            Exit For
        End If
    Next

End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...