Функция объединения для рабочих листов

Question

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

Следующим моим шагом было повторить код цикла, и на этот раз вместо того, чтобы раскрашивать и добавлять имя в строку, я собирался удалить лист.

Есть ли способ создать набор выбора при первом прохождении цикла, чтобы, если выбрана опция удаления, я мог сделать что-то похожее на selection.delete?

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 Not exception(ws.CodeName) 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
        'SELECTION_SET = UNION(SELECTION_SET, ws)
        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

        'avoid looping again. build selection set in first loop
        'then delete section.
    End If

End Sub

Я посмотрел на UNION FUNCTION , но если я правильно понял, он используется для диапазонов, а не рабочих листов.

Есть ли лучший способ добиться того, что я описываю?

Answer 1

Вам нужно будет повторить цикл, но таким образом цикл будет происходить только на тех листах, которые нужно удалить:

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 Not exception(ws.CodeName) 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
        'SELECTION_SET = UNION(SELECTION_SET, ws)
        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")

    Dim SplitSheets As Variant 'Declare an Array type variable
    Dim i As Integer

    If Delete_Orphans = vbYes Then
        'loop through sheets again and delete
        SplitSheets = Split(ws_List, ", ") 'here you will split all the names into one array
        For i = LBound(SplitSheets) To UBound(SplitSheets) 'this way you will loop, but only on the sheets you need to.
            wb.Sheets(SplitSheets(i)).Delete
        Next i
        'avoid looping again. build selection set in first loop
        'then delete section.
    End If

End Sub