Блог

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

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

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

 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" amp; Item_List_First_Row amp; ":C" amp; 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 amp; ", " amp; 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:  " amp; vbLf amp; vbLf amp; ws_List amp; vbLf amp; vbLf amp; "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
  

Я посмотрел на ФУНКЦИЮ ОБЪЕДИНЕНИЯ, но, если я правильно понимаю, она используется для диапазонов, а не для рабочих листов.

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

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

 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" amp; Item_List_First_Row amp; ":C" amp; 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 amp; ", " amp; 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:  " amp; vbLf amp; vbLf amp; ws_List amp; vbLf amp; vbLf amp; "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