有条件地更改创建修改数组的数组内容

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

字典是保存工作表列表的便捷方式

添加了包含工作表索引，工作表名称和存在方法

的好处

此代码使用Sub 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

结果：