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