Question

我有以下VBA脚本，适用于创建新工作表和订购它们。我将尝试从列表中删除项目后删除工作表。我怎么能这样做呢？

Sub AddSheet()
    Application.ScreenUpdating = False
    Sheets("Master").Visible = True
    Dim bottomA As Integer
    bottomA = Range("A" & Rows.Count).End(xlUp).Row
    Dim c As Range
    Dim ws As Worksheet
    For Each c In Sheets("01_Update_Employee_Lists").Range("E2:E" & bottomA)
        Set ws = Nothing
        On Error Resume Next
        Set ws = Worksheets(c.Value)
        On Error GoTo 0
        If ws Is Nothing Then
            Sheets("master").Select
            Sheets("master").Copy After:=Sheets(Sheets.Count)
            ActiveSheet.Name = c.Value
        End If
    Next c
    Sheets("Master").Visible = False
    Application.ScreenUpdating = True

' sort worksheets in a workbook in ascending order
Dim sCount As Integer, i As Integer, j As Integer
    Application.ScreenUpdating = False
    sCount = Worksheets.Count
    If sCount = 1 Then Exit Sub
    For i = 1 To sCount - 1
        For j = i + 1 To sCount
            If (Worksheets(j).Name < Worksheets(i).Name) Then
                Worksheets(j).Move Before:=Worksheets(i)
            End If
        Next j
    Next i
End Sub

Answer 1

我通常尽可能避免On Error Resume Next。我知道这是一种公认的编程习惯，但对我而言，打破某些东西以证明它并不存在是错误的。无论如何，通常有替代方法。

Sub AddSheet()
    Application.ScreenUpdating = False
    Sheets("Master").Visible = True
    Dim wn As Long, ws As Long, rWSLST As Range

    With Sheets("01_Update_Employee_Lists")
        Set rWSLST = .Range("E2:E" & .Range("A" & Rows.Count).End(xlUp).Row)
        For wn = 2 To .Range("A" & Rows.Count).End(xlUp).Row
            If CBool(Len(Trim(.Cells(wn, "E").Value))) Then
                For ws = 1 To Sheets.Count
                    If LCase(Sheets(ws).Name) = LCase(.Cells(wn, "E").Value) Then Exit For
                Next ws
                If ws > Sheets.Count Then
                    Sheets("master").Copy After:=Sheets(Sheets.Count)
                    Sheets(Sheets.Count).Name = .Cells(wn, "E").Value
                End If
            End If
        Next wn
        For wn = 1 To (Sheets.Count - 1)
            For ws = wn + 1 To Sheets.Count
                If (Sheets(ws).Name < Sheets(wn).Name) Then
                    Sheets(ws).Move Before:=Sheets(wn)
                End If
            Next ws
        Next wn
        Sheets("Master").Move Before:=Sheets(1)
        Application.DisplayAlerts = False
        For ws = Sheets.Count To 1 Step -1
            If LCase(Sheets(ws).Name) <> "master" And Sheets(ws).Name <> .Name Then
                If Not CBool(Application.CountIf(rWSLST, Sheets(ws).Name)) Then
                    Sheets(ws).Delete
                End If
            End If
        Next ws
        Application.DisplayAlerts = True
        Set rWSLST = Nothing
    End With

    Sheets("Master").Visible = False
    'Sheets("Master").Visible = xlVeryHidden
    Application.ScreenUpdating = True
 End Sub

我已添加一条注释行，用于设置主工作表xlVeryHidden，它在取消隐藏工作表对话框中甚至无法显示。你只需要一个或另一个，而不是两者。

删除不在列表中的Excel工作表

1 个答案: