更改陣列內容有條件地創建修改後的陣列

Question

我有以下代碼，它在工作簿中搜索名爲1到12的工作表，並且如果找到1到12的工作表，則創建兩個工作表。如果1到12之間的任何頁面不存在，它會考慮錯誤。每次可以從1到12中缺少一個或多個表單。是否可以創建另一個數組或更改數組內容，這些內容只包含與工作簿中存在的表單相對應的數字，以便我可以使用此修改所有其他代碼中的數組將應用於這些表單。麻煩建議與一個新的修改後的數組只能中1現有片材的被創建來12.

Sub add_sheets() 
Dim MyArr, j As Long 
Dim wsarray As Sheets 
Dim ws As Worksheet 

MyArr = Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12") 

For j = 0 To UBound(MyArr) 
Set ws = Nothing 

On Error Resume Next 
Set ws = Worksheets(MyArr(j)) 
On Error GoTo 0 
If Not ws Is Nothing Then 

ActiveWorkbook.Sheets.Add After:=ws, Count:=2 
Sheets(ActiveSheet.Index - 2).Activate 

Else 
Err.Clear 
End If 
Next 
End Sub 

Answer 1

字典的代碼是保持工作表

具有兩個額外的好處列表方便的方式片索引，片材名稱，並且Exists方法

該代碼使用在子SetWorksheets（）的意見的建議，而不會觸發錯誤：

Option Explicit 'Add reference to: Tools -> References -> Microsoft Scripting Runtime 

Public Sub AddSheets() 
    Dim wsList As Dictionary 
    Dim activeWs As Worksheet, wb As Workbook, ws As Worksheet 

    Application.ScreenUpdating = False 
     Set wb = ThisWorkbook 
     Set activeWs = wb.ActiveSheet 
     Set wsList = New Dictionary:   'wsList.CompareMode = BinaryCompare 
     SetWorksheets wsList 
     TestWorksheets wsList, "Initial Worksheets" 
     While wsList.Count < 12 
      Set ws = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)) 
      With ws 
       wsList.Add Key:=.Index, Item:=.Name 
      End With 
     Wend 
     TestWorksheets wsList, "Final Worksheets" 
     DelWorksheets 
     activeWs.Activate 
    Application.ScreenUpdating = True 
End Sub 

Public Sub SetWorksheets(ByRef wsLst As Dictionary, _ 
         Optional ByRef wb As Workbook = Nothing) 
    Dim ws As Worksheet 
    If wb Is Nothing Then Set wb = ThisWorkbook 
    For Each ws In wb.Worksheets 
     With ws 
      wsLst.Add Key:=.Index, Item:=.Name 'Or: d.Add Key:=.Name, Item:=.Index 
     End With 
    Next 
End Sub 

注意，因爲它可能不是很明顯：SetWorksheets（）是一個Sub而不是一個Function，因爲第一個參數傳遞給了ByRef，這意味着它將在Sub中被更改。結果發送到這個子最初的對象也將被更新

爲了測試它：

Public Sub TestWorksheets(ByRef wsLst As Dictionary, txt As String) 
    Dim itm As Variant, msg As String 
    msg = txt & ": " & vbCrLf & vbCrLf 
    For Each itm In wsLst 
     With itm 
      msg = msg & vbTab & itm & ": " & vbTab & wsLst.Item(itm) & vbCrLf 
     End With 
    Next 
    MsgBox msg & vbCrLf & "Sheet 5 exists: " & vbTab & wsLst.Exists(5) 
End Sub 

Public Sub DelWorksheets() 
    Dim itm As Worksheet 
    Application.DisplayAlerts = False 
    For Each itm In ThisWorkbook.Worksheets 
     If itm.Index > 3 Then itm.Delete 
    Next 
    Application.DisplayAlerts = True 
End Sub 

結果：