在VBA中声明和初始化一个动态数组表格

Question

我想在Excel中创建一个数组表格。每张工作表都有多个列和行，需要进行搜索，比较和填充。我无法创建工作表数组。我在＃27行不断收到下标超出范围错误。它发生在所有4张纸上，如果我注释掉前面的那些。

Sub news() 

    'activate sheets 
    Sheet1.Activate 
    Sheet2.Activate 
    Sheet3.Activate 
    Sheet4.Activate 

    'array of letters for the columns 
    Dim alpha(1 To 13) As String 
    alpha(1) = "a" 
    alpha(2) = "b" 
    alpha(3) = "c" 
    alpha(4) = "d" 
    alpha(5) = "e" 
    alpha(6) = "f" 
    alpha(7) = "g" 
    alpha(8) = "h" 
    alpha(9) = "i" 
    alpha(10) = "j" 
    alpha(11) = "k" 
    alpha(12) = "l" 
    alpha(13) = "m" 

    'array of sheets 
    Dim shets() As Sheets, sheetCount As Integer 
    Set shets(1) = Sheets("Sheet1") 
    Set shets(2) = Sheets("Sheet2") 
    Set shets(3) = Sheets("Sheet3") 
    Set shets(4) = Sheets("Sheet4") 

    'used to make sure i am not shifted and photos goes to photos, videos to videos, and compliance to compliance 
    Dim newShift As Integer 
    newShift = 7 

    'for loop counter variables 
    Dim i, j, k As Integer 

    'goes through the sheets 
    For i = 2 To sheetCount 
     'goes through the columns 
     For j = 3 To 7 Step 2 
      'goes through the rows 
      For k = 2 To ThisWorksheet.Rows.count 
       If (Sheets(shets(i - 1)).Cells(k, alpha(j)) = Sheets(shets(i)).Cells(k, alpha(j))) Then 
        Sheets(shets(i)).Cells(k, alpha(j + newShift)) = False 
       ElseIf (Sheets(shets(i - 1)).Cells(k, alpha(j)) < Sheets(shets(i)).Cells(k, alpha(j))) Then 
        Sheets(shets(i)).Cells(k, alpha(j + newShift)) = True 
       Else 
        Sheets(shets(i)).Cells(k, alpha(j + newShift)) = "ERROR" 
       End If 
      Next 
      newShift = newShift - 1 
     Next 
    Next 

End Sub 

Answer 1

上面发布的代码中有相当多的代码有问题。我已经完成并重写了这些违规行，并且在下面的代码中包含了为什么要说明原因。

不仅应该修复你的“超出范围”错误（因为你没有声明你的数组的大小），但它会修复你还没遇到的其他错误（不声明变量值，循环遍历每一个每个工作表中的行，不正确引用表单对象，...）。

Sub news() 
    ' No need to activate sheets 
    ' No need for array of letters for the columns: '.Cells(row,col)' can take a number for 'col' 
    ' Integers replaced by Longs, no real incentive to use Integer type and Long can be larger 

    ' Array of sheets: use WorkSheet objects, not a Sheets object 
    Dim shets() As WorkSheet 
    ' Remember to assign a value to sheetCount 
    Dim sheetCount As Long: sheetCount = 4 
    ' Must declare the size of your array, this method keeps it generic 
    ' could have used 'Dim shets(1 To 4) As WorkSheet' 
    Dim n As Long 
    ReDim shets(1 To sheetCount) 
    ' Keeping with generic theme, loop over shets to define sheets, makes expanding easier 
    For n = 1 To sheetCount 
     ' Fully qualify sheets by using workbook object 
     Set shets(n) = ThisWorkbook.Sheets("Sheet" & n) 
    Next n 
    ' Used to make sure photos goes to photos, videos to videos, and compliance to compliance 
    Dim newShift As Long: newShift = 7 
    ' For loop counter variables: Must specify EACH type, 'Dim i, j, k As Long' declares i and j as Variants 
    Dim i As Long, j As Long, k As Long 
    ' Go through the sheets 
    For i = 2 To sheetCount 
     ' Go through the columns 
     For j = 3 To 7 Step 2 
      ' Go through the rows. Don't just use '.Rows' object as that includes all unused rows in sheet! 
      ' Also using one of the sheet objects, as 'ThisWorksheet' doesn't exist 
      For k = 2 To shets(i).UsedRange.Rows.Count 
       ' Don't access sheet objects using 'Sheets(shets(..))', simply use 'shets(..)' 
       If shets(i - 1).Cells(k, j) = shets(i).Cells(k, j) Then 
        shets(i).Cells(k, j + newShift).Value = False 
       ElseIf shets(i - 1).Cells(k, j) < shets(i).Cells(k, j) Then 
        shets(i).Cells(k, j + newShift).Value = True 
       Else 
        shets(i).Cells(k, j + newShift).Value = "ERROR" 
       End If 
      Next 
      newShift = newShift - 1 
     Next 
    Next 
End Sub