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

Question

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

操作我想宏做：

1）如果工作表名称的数组值相匹配无能为力
2）如果没有片数组值，创建模板表的副本并用数组值重新命名。此外，将复制工作表的单元格A1命名为数组值。
3）如果数组中不存在表单，请删除表单。除名为输入或模板的图纸外。

到现在我有两个单独的代码，一个复制表和其他删除表：

准则，以添加图纸：

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代码中添加except规则？

3）如何将这些代码合并成一个代码，最后创建一个按钮在输入表中激活这个宏？

非常感谢提前！

Answer 1

你在这里。您要做的第一件事是在模块的顶部添加Option Compare Text以与Like Operator一起使用。我必须恭维你使用范围（“A”& Rows.Count）。结束（xlUp）。行这是我最喜欢的找到最大行的方法。作为一种更好的做法，我建议将所有Dim语句放在每个Sub的顶部。

我选择首先执行删除操作，因为员工列表在过程中不会更改，但可以减少增加的工作表数量。加快你的位置，对吧？下面的代码将从输入工作表中的B列（不包括B1）中获取员工姓名。我将输入和模板工作表名称指定为常量，因为它们通过代码多次使用。这样，如果你决定给他们打电话，你就不会通过代码来寻找。

即使程序已经合并在这里，我们可以有放置DeleteSheet为AddSheet（最后一行容易called another procedure from the 1st）这并不需要使用之初呼叫的。它在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