VBA:从列表中添加和删除工作表

Question

我正在编写一段代码，它根据 Excel 工作表中从单元格 B2 开始的列的内容创建某个模板工作表的副本或删除工作表。

我希望宏执行的操作:

1) 如果工作表名称与数组值匹配，则什么都不做
2) 如果数组值没有工作表，则创建模板工作表的副本并使用数组值重命名。此外，将复制的工作表的单元格 A1 命名为数组值。
3)如果存在数组中不存在的sheet，则删除该sheet。除了名为 Input 或 Template 的工作表。

到目前为止，我有两个单独的代码，一个用于复制工作表，另一个用于删除工作表:

添加工作表的代码:

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

删除工作表的代码:

Sub DeleteSheet()
Dim i As Long, x, wsAct As Worksheet
Set wsAct = ActiveSheet
For i = Sheets.Count To 1 Step -1
    If Not Sheets(i) Is wsAct Then
        x = Application.Match(Sheets(i).name, wsAct.Range("A1:A20"), 0)
        If IsError(x) Then
            Application.DisplayAlerts = False
            Sheets(i).Delete
            Application.DisplayAlerts = True
        End If
    End If
    Next i
    End Sub

我的问题是:

1) 如何在 AddSheet 代码中添加用数组值重命名单元格 A1 的部分？

2) 如何在 DeleteSheet 代码中添加异常(exception)规则？

3) 如何将这些代码组合成一个代码并最终在输入表中创建一个按钮来激活此宏？

非常感谢!

Answer 1

给你。您要做的第一件事是在模块顶部添加选项比较文本，以便与Like Operator 一起使用。 .我必须赞美你使用 Range("A"& Rows.Count).End(xlUp).Row 这是我最喜欢的查找最大行的方法。作为更好的做法，我建议将所有 Dim 语句放在每个 Sub 的顶部。

我选择首先运行删除操作，因为在此过程中员工列表不会更改，但可以减少添加操作必须循环的工作表数量。尽可能加快速度，对吗？下面的代码将从输入工作表的 B 列(不包括 B1)中获取员工姓名。我将输入和模板工作表名称指定为常量，因为它们在代码中被多次使用。这样一来，如果您决定给它们起别的名字，就不会在代码中搜索。

即使程序已经在这里合并，我们也可以很容易地得到 called another procedure from the 1st通过将 DeleteSheet 放在 AddSheet() 的最后一行，这不需要在开头使用 Call。它出现在 Visual Basic 的早期，但现在已经很久没有出现了。如果有任何不清楚或无法正常工作，请告诉我。

Sub CheckSheets()
    Dim wksInput As Worksheet
    Dim wks As Worksheet
    Dim cell As Range
    Dim MaxRow As Long
    Dim NotFound As Boolean
    Dim Removed As String
    Dim Added As String

    'Assign initial values
    Const InputName = "Input"
    Const TemplateName = "Template"
    Set wksInput = Worksheets(InputName)
    MaxRow = wksInput.Range("B" & Rows.Count).End(xlUp).Row

    Application.ScreenUpdating = False

    'Delete worksheets that don't match Employee Names or are not Input or Template
    For Each wks In Worksheets
        NotFound = True
        'Keep Input and Template worksheets safe
        If Not (wks.Name Like InputName Or wks.Name Like TemplateName) Then
            'Check all current Employee Names for matches
            For Each cell In wksInput.Range("B2:B" & MaxRow)
                If wks.Name Like cell Then
                    NotFound = False
                    Exit For
                End If
            Next cell
        Else
            NotFound = False
        End If
        'Match was not found, delete worksheet
        If NotFound Then
            'Build end message
            If LenB(Removed) = 0 Then
                Removed = "Worksheet '" & wks.Name & "'"
            Else
                Removed = Removed & " & '" & wks.Name & "'"
            End If
            'Delete worksheet
            Application.DisplayAlerts = False
            wks.Delete
            Application.DisplayAlerts = True
        End If
    Next wks

    'Check each Employee Name for existing worksheet, copy from template if not found
    For Each cell In wksInput.Range("B2:B" & MaxRow)
        NotFound = True
        For Each wks In Worksheets
            If wks.Name Like cell Then
                NotFound = False
                Exit For
            End If
        Next wks
        'Employee Name wasn't found, copy template
        If NotFound And LenB(Trim(cell & vbNullString)) <> 0 Then
            'Build end message
            If LenB(Added) = 0 Then
                Added = "Worksheet '" & cell & "'"
            Else
                Added = Added & " & '" & cell & "'"
            End If
            'Add the worksheet
            Worksheets(TemplateName).Copy After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = cell
            ActiveSheet.Range("A1") = cell
        End If
    Next cell

    'Added here so user sees worksheets when the message displays
    Application.ScreenUpdating = True

    'Final message touchups and display to user
    If LenB(Removed) <> 0 And LenB(Added) <> 0 Then
        Removed = Removed & " has been removed from the workbook." & vbNewLine & vbNewLine
        Added = Added & " has been added to the workbook."
        MsgBox Removed & Added, vbOKOnly, "Success!"
    ElseIf LenB(Removed) <> 0 Then
        Removed = Removed & " has been removed from the workbook."
        MsgBox Removed, vbOKOnly, "Success!"
    ElseIf LenB(Added) <> 0 Then
        Added = Added & " has been added to the workbook."
        MsgBox Added, vbOKOnly, "Success!"
    End If
End Sub