运行数组中的过程

Question

我有一个程序可以根据可用数据创建一个新的 sheet。基本上，它会根据数据名称创建一个 sheet。代码编写如下。如果我一个一个分配程序，它确实有效。

Sub new_profile(tankname)
    Sheets.Add After:=ActiveSheet
    Range("B4").Select
    ActiveCell.FormulaR1C1 = tankname
    ActiveSheet.Name = Range("b4").Value

end sub

由于我会将此代码用于另一个工作簿（这意味着没有确切的数据量），我尝试分配一个数组以自动运行整个过程无需调用一个接一个。代码如下：

Sub calculate_all()

Dim cel As Range
Dim tank_name() As String
Dim i As Integer, j As Integer
Dim n As Integer

i = 11
n = Range("B6").Value

ReDim tank_name(i)

For Each cel In ActiveSheet.Range(Cells(11, 2), Cells(11 + n, 2))
    tank_name(i) = cel.Value
    i = i + 1
    
    new_profile tank_name(i)
    ReDim Preserve tank_name(i)
    
Next cel

结束子

不幸的是，它变成错误并显示消息“下标超出范围”。我该如何解决这个问题？

Answer 1

对于数组中的每个元素运行一个过程

假设创建新配置文件意味着添加新的 sheet、重命名并将名称写入单元格。
只有在 TankNames 数组中不存在具有当前名称的作品sheet 时，第一个主程序 createProfiles 才执行前面提到的。
第二个过程 deleteProfiles 删除所有 sheet，如果它们的名字存在于 TankNames 数组中。
第三个和第四个过程被前面提到的两个过程调用，而第五个显然只被主过程调用。
在运行前两个过程中的任何一个之前，调整其中的常量以满足您的需要。

代码

Option Explicit

Sub createProfiles()

    ' Source
    Const wsName As String = "Sheet1" ' Tab Name
    Const FirstRow As Long = 11
    Const NameCol As Variant = "B" ' e.g. 1 or "A", 2 or "B"...
    ' Target
    Const CellAddress As String = "B4"
    ' Other
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Define Source Worksheet.
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    ' Write tank names from Source Worksheet to TankNames array.
    Dim TankNames As Variant
    getColumn TankNames, ws, NameCol, FirstRow

    Dim i As Long
    ' Loop through elements of TankNames array.
    For i = 1 To UBound(TankNames)
        ' For each tank name create a new profile.
        If Not foundSheetName(wb, TankNames(i, 1)) Then
            Call createProfile wb, TankNames(i, 1), CellAddress
        End If
    Next i

End Sub

Sub deleteProfiles()
    ' Source
    Const wsName As String = "Sheet1" ' Tab Name
    Const FirstRow As Long = 11
    Const NameCol As Variant = "B" ' e.g. 1 or "A", 2 or "B"...
    ' Other
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Define Source Worksheet.
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    ' Write tank names from Source Worksheet to TankNames array.
    Dim TankNames As Variant
    getColumn TankNames, ws, NameCol, FirstRow

    Dim i As Long
    ' Loop through elements of TankNames array.
    For i = 1 To UBound(TankNames)
        ' For each tank name delete profile (sheet).
        If foundSheetName(wb, TankNames(i, 1)) Then
            Application.DisplayAlerts = False
            wb.Worksheets(TankNames(i, 1)).Delete
            Application.DisplayAlerts = True
        End If
    Next i

End Sub

Sub getColumn(ByRef Data As Variant, _
              Sheet As Worksheet, _
              Optional ByVal ColumnID As Variant = 1, _
              Optional ByVal FirstRow As Long = 1)
    
    Data = Empty
    If Sheet Is Nothing Then Exit Sub
    
    Dim rng As Range
    Set rng = Sheet.Columns(ColumnID).Find("*", , xlValues, , , xlPrevious)
    If rng Is Nothing Then Exit Sub
    If rng.Row < FirstRow Then Exit Sub
    Set rng = Sheet.Range(Sheet.Cells(FirstRow, ColumnID), rng)
    
    If rng.Cells.Count > 1 Then
        Data = rng.Value
    Else
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rng.Value
    End If
    
End Sub
    
Function foundSheetName(Book As Workbook, _
                        Optional ByVal SheetName As String = "Sheet1") _
         As Boolean
    If Book Is Nothing Then Set Book = ActiveWorkbook
    On Error Resume Next
    Dim ws As Worksheet: Set ws = Book.Worksheets(SheetName)
    If Err.Number = 0 Then foundSheetName = True
End Function

Sub createProfile(Book As Workbook, _
                  ByVal NewName As String, _
                  ByVal NameCellAddress As String)
    Dim ws As Worksheet
    Set ws = Book.Worksheets.Add(After:=Book.Sheets(Book.Sheets.Count))
    With ws
        .Name = NewName
        .Range(NameCellAddress) = NewName
    End With
End Sub

运行数组中的过程

Running a Procedure in an Array

arrays

excel

vba

procedure

对于数组中的每个元素运行一个过程

运行 数组中的过程

Running a Procedure in an Array

arrays

excel

vba

procedure

对于数组中的每个元素运行一个过程

运行数组中的过程