VBA 尝试遍历数组以读取值时下标超出范围

Question

我正在绞尽脑汁试图找出我在下面的代码中做错了什么。我有一串预定义的工作 sheet，我需要运行特定的代码，但我遇到了编译错误。代码设置为将数据从一个 sheet 复制到另一个。我如何让它为多个 sheet 做同样的事情？

当我单步执行代码时，sht 显示 MHP60,MHP61,MHP62 而不仅仅是 MHP60。

我一直收到下标超出范围的错误。

Sub Prepare_CYTD_Report()
    Dim addresses() As String
    Dim addresses2() As String
    Dim SheetNames() As String
    Dim SheetNames2() As String
    Dim wb1 As Workbook, wb2 As Workbook
    Dim my_Filename
    
    'Declare variables for MHP60, MHP61, MHP62 Trial Balance Values
    Dim i, lastcol As Long
    Dim tabNames, cell As Range
    Dim tabName As String
    Dim sht As Variant
  
   
    addresses = Strings.Split("A9,A12:A26,A32:A38,A42:A58,A62:A70,A73:A76,A83:A90", ",") 'Trial Balance string values
    addresses2 = Strings.Split("G9,G12:G26,G32:G38,G42:G58,G62:G70,G73:G76,G83:G90", ",")  'Prior Month string values
    SheetNames = Strings.Split("MHP60,MHP61,MHP62")
    'SheetNames2 = Strings.Split("MHP60-CYTDprior,MHP61-CYTDprior,MHP62-CYTDprior")
    
    Set wb1 = ActiveWorkbook    'Revenue & Expenditure Summary Workbook
    
    '*****************************Open CYTD files
    my_Filename = Application.GetOpenFilename(fileFilter:="Excel Files,*.xl*;*.xm*", Title:="Select File to create CYTD Reports")

    If my_Filename = False Then
        Exit Sub
    End If

    Application.ScreenUpdating = False
    Set wb2 = Workbooks.Open(my_Filename)
    
    '*****************************Load Column Header Strings & Copy Data
    For Each sht In SheetNames
        lastcol = wb1.Sheets(sht).Cells(5, Columns.Count).End(xlToLeft).Column
    
        On Error Resume Next
        Set tabNames = wb1.Sheets(sht).Cells(4, 3).Resize(1, lastcol - 2).SpecialCells(xlCellTypeConstants)
        'actual non-formula text values on row 4 from column C up to column lastCol'
        On Error GoTo 0
        If Err.Number <> 0 Then
            MsgBox "No headers were found on row 4 of MHP60", vbCritical
            Exit Sub
        End If
    
        For Each cell In tabNames
        tabName = Strings.Trim(cell.Value2)
        'dedicated variable in case of requirement for further parsing (space/comma elimination?)'
            If CStr(wb1.Sheets(sht).Evaluate("ISREF('[" & wb2.Name & "]" & tabName & "'!$A)")) = "True" Then
            'If wb2 has a tab named for the value in tabName
                For i = 0 To UBound(addresses)
                    wb2.Sheets(tabName).Range(addresses(i)).Value2 = wb1.Sheets(sht).Range(addresses(i)).Offset(0, cell.Column - 1).Value2
                    'Debug.Print "data for " & wb2.Sheets(tabName).Range(addresses(i)).Address(, , , True) & " copied from " & wb1.Sheets("MHP60").Range(addresses(i)).Offset(0, cell.Column - 1).Address(, , , True)
                Next i
            Else
                Debug.Print "A tab " & tabName & " was not found in " & wb2.Name
            End If
        Next cell
    Next sht
      
    MsgBox "CYTD Report Creation Complete", vbOKOnly
        
    Application.ScreenUpdating = True
End Sub

Answer 1

被什么分开？

SheetNames = Strings.Split("MHP60,MHP61,MHP62")

用逗号分隔？然后改用以下内容：

SheetNames = Strings.Split("MHP60,MHP61,MHP62", ",")

备选

Dim SheetNames() As Variant  ' needs to be Variant to work with Array()
SheetNames = Array("MHP60", "MHP61", "MHP62")

这应该会更快，因为您的宏不需要拆分字符串并直接将其作为数组。

VBA 尝试遍历数组以读取值时下标超出范围

VBA Subscript out of range when trying to loop through array to read values

arrays

excel

vba