工作表的联合函数

Question

我有一个子程序，它遍历我的工作表，并通过将其选项卡涂成红色来对其进行标记，并将其工作表名称添加到字符串中。循环完成后，将显示一个消息框，其中列出了工作表名称字符串并询问是否应删除所有列出的工作表的消息。

我的下一步将是重复循环的代码，这一次，而不是为字符串着色和添加名称，我要删除工作表。

是否有一种方法可以在第一次循环时建立选择集，以便如果选择了delete选项，我可以执行类似于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