遍历数组以在 Vba 中创建工作表

Looping through arrays to create worksheet in Vba

我需要一些帮助。我正在尝试通过遍历数组来检查和创建工作簿中的新工作表。我如何将 Arr() 分配为对象?请指教

  Sub update()
    Dim myworksheet As Worksheet
    
    Dim Arr() As Variant

Arr() = Array ("Square", "Circle", "Rectangle", "Hexagon")
icount = WorksheetFunction.CountA(Arr())
Z = 0
For k = Z To icount
**Set myworksheet = Worksheets(Arr(Z)) '<---- THIS throws me out of subscript error** 
If Not sheetexists("myworksheet") Then
Worksheets.Add.Name = "myworksheet"
End If
Z = Z + 1
Next k
End Sub

Function sheetexists(shtname As String, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtname)
On Error GoTo 0
sheetexists = Not sht Is Nothing
End Function
End Function

这里有一些问题。首先你设置:
icount = WorksheetFunction.CountA(Arr())
在这种情况下是 4.
但是它们的数组从 0 开始,所以当您执行 For k = Z To icount 时,您会说“从 0 到 4”
但是 Worksheets(Arr(4)) 不存在,因为数组有项目 0-3.

接下来 If Not sheetexists("myworksheet") Then 查找名为“myworksheet”的工作表,而不是我们刚刚分配的变量 myworksheet
您可能需要 If Not sheetexists(myworksheet.Name) Then
我猜 Worksheets.Add.Name = "myworksheet"

也有同样的问题

那么真的不需要两个计数器 k 和 z,因为 k 将从 0 开始并且 next k 将设置它 + 1。

Set myworksheet = Worksheets(Arr(Z)) 然而在这里并没有真正起作用。首先将工作表设置为变量,然后检查它是否存在。但如果不存在,则无法设置。

因此,如果我们改用字符串,效果应该会更好:

Sub update()
Dim myworksheet As String
Dim Arr() As Variant
Dim k As Long

Arr() = Array("Square", "Circle", "Rectangle", "Hexagon")
For k = LBound(Arr) To UBound(Arr)
    myworksheet = Arr(k)
    If Not sheetexists(myworksheet) Then
        Worksheets.Add.Name = myworksheet
    End If
Next k
End Sub

这是作为奖励的每个循环的示例:

Sub update()
Dim k As Variant
For Each k In Array("Square", "Circle", "Rectangle", "Hexagon")
    If Not sheetexists(k) Then
        Worksheets.Add.Name = k
    End If
Next k
End Sub

Function sheetexists(shtname As Variant, Optional wb As Workbook) As Boolean
Dim sht As Worksheet
If wb Is Nothing Then Set wb = ThisWorkbook
On Error Resume Next
Set sht = wb.Sheets(shtname)
On Error GoTo 0
sheetexists = Not sht Is Nothing
End Function

注意sheetexists中的shtname变量在这里改成了变体

如果不存在,您可以按照下面整洁的代码检查是否添加工作表。否则什么都不做。如果添加更多工作表,则易于重构和管理。

Option Explicit

Public wb As Workbook
Public ws As Worksheet

'Declare the sheets in this array you want to add
Function sheetNamesArray() As Variant
    sheetNamesArray = Array("Square", "Circle", "Rectangle", "Hexagon")
End Function

' Function returns True, if sheet exist else returns False
Function isSheetExist(sSheet As String) As Boolean
    On Error Resume Next
    isSheetExist = (ActiveWorkbook.Sheets(sSheet).Index > 0)
End Function


'Function to Create a Sheet in workbook with given name
Sub CreateSheet(sheetName As Variant)
    Set wb = ThisWorkbook
    With ThisWorkbook
        .Sheets.Add(After:=.Sheets(.Sheets.Count)).Name = sheetName
    End With
    
End Sub

'Function to addSheets if doesn't exist, else do nothing
Sub Main()
    Dim asheet As Variant
    For Each asheet In sheetNamesArray
            If Not isSheetExist(CStr(asheet)) Then
                Call CreateSheet(asheet)
            End If
    Next asheet
End Sub