更改阵列内容有条件地创建修改后的阵列

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 

结果：