循环成功，但以"Subscript Out of Range“结束

Question

我在我的VBA代码中遇到了一个特性。代码用表中的数据填充数组myArray，然后多次粘贴数组，每次迭代和粘贴时编辑两列中的数据。

下面的代码成功执行，但始终以“运行时错误'9'：下标超出范围”结束。

Option Explicit

Public myArray As Variant
Public i As Integer
Public r As Integer
Public slist() As Variant
Public qlist() As Variant
Public comcols() As Variant

---------------------------------------------------------------------------    
Sub Scopier()

myArray = ActiveWorkbook.Worksheets("Semesters").ListObjects("tblSemester").DataBodyRange.Value

slist = ActiveWorkbook.Worksheets("Lists").ListObjects("tblslist").DataBodyRange.Value

For r = 1 To 10
    Call loopthroughs
    Call spit
Next r

End Sub
---------------------------------------------------------------------------
Sub loopthroughs()

For i = 1 To UBound(myArray, 1)
    myArray(i, 5) = slist(r, 2)
    myArray(i, 6) = slist(r, 1)
    myArray(i, 7) = "Upcoming"
    myArray(i, 13) = "Pending"
    myArray(i, 19) = "Scheduling"
    myArray(i, 22) = "Course Schedule"
Next

End Sub
---------------------------------------------------------------------------    
Sub spit()

If IsEmpty(ActiveWorkbook.Worksheets("Sheet1").Range("A2")) Then
    ActiveWorkbook.Worksheets("Sheet1").Range("A2", "V2").Resize(UBound(myArray)).Value = myArray
Else
    ActiveWorkbook.Worksheets("Sheet1").Range("A1").End(xlDown).Offset(1, 0).Activate
    Range(ActiveCell, ActiveCell.Offset(0, 22)).Resize(UBound(myArray)).Value = myArray
End If

End Sub

调试时，只有在每次迭代成功之后，for循环中的第一行才会发生错误。

Sub loopthroughs()

For i = 1 To UBound(myArray, 1)
    myArray(i, 5) = slist(r, 2) <------ This line is the debug error
    myArray(i, 6) = slist(r, 1)
    myArray(i, 7) = "Upcoming"
    myArray(i, 13) = "Pending"
    myArray(i, 19) = "Scheduling"
    myArray(i, 22) = "Course Schedule"
Next

End Sub

奇怪的是，相同代码的略微修改版本(如下所示)可以成功执行，而不会出现这个运行时错误。

Sub Qcopier()

myArray = ActiveWorkbook.Worksheets("Quarters").ListObjects("tblquarter").DataBodyRange.Value

qlist = ActiveWorkbook.Worksheets("Lists").ListObjects("tblqlist").DataBodyRange.Value

For r = 1 To 12
    Call loopthroughq
    Call spit
Next r

End Sub
---------------------------------------------------------------------------
Sub loopthroughq()

For i = 1 To UBound(myArray, 1)
    myArray(i, 5) = qlist(r, 2)
    myArray(i, 6) = qlist(r, 1)
    myArray(i, 7) = "Upcoming"
    myArray(i, 13) = "Pending"
    myArray(i, 19) = "Scheduling"
    myArray(i, 22) = "Course Schedule"
Next

End Sub

我不明白为什么第一个代码块有这个运行时错误。我想象loopthroughs()函数试图在myArray上迭代一次(或更多次)，而不是它的行数，但是我不知道如何修改它。

我尝试了对子循环()进行一些细微的修改，包括将Ubound值更改为Ubound(myArray)和(Ubound(myArray，1) - 1)，但似乎都不起作用。

我的VBA知识有限，需要一些帮助。

Answer 1

进行一些错误检查，看看每次迭代都发生了什么。这是我为一个维度写的。我在下面的代码中查找边界、数组索引和数组值。如果我知道您的数据是什么样子(或虚拟集)，它将有助于使用此脚本。

Option Explicit
Private Sub CommandButton1_Click()
Dim myArray As Variant
Dim toutput As String
Dim indexoutput As String
Dim i As Integer
Dim WKS As Worksheet
Dim rng As Range
Set WKS = ThisWorkbook.ActiveSheet
Set rng = WKS.Range("G1:G10")

myArray = rng

'LBound here is 1 and UBound is 10
For i = LBound(myArray, 1) To UBound(myArray, 1)
indexoutput = indexoutput & i & " // "
toutput = toutput & myArray(i, 1) & ", "
Next i

MsgBox LBound(myArray, 1) & vbCrLf & UBound(myArray, 1) & vbCrLf & indexoutput & vbCrLf & toutput

End Sub

https://excelmacromastery.com/excel-vba-array/

它将访问2D数组显示为：

For i = LBound(arr,1) To UBound(arr,1)
  For j = LBound(arr,2) To UBound(arr,2)
  Next j
Next i

并将所有项目视为：

Dim item As Variant
   For Each item In arr
Next item

我很确定我们可以很快找到大小问题的答案。

但我在这些表和列表定义中看不到您的范围，您需要提供更多信息。

  myArray = ActiveWorkbook.Worksheets("Semesters").ListObjects("tblSemester").DataBodyRange.Value

    slist = ActiveWorkbook.Worksheets("Lists").ListObjects("tblslist").DataBodyRange.Value

Answer 2

当我将scopier()中的for循环从

For r = 1 To 10
    Call loopthroughs
    Call spit
Next r

至

For r = 1 To Ubound(slist)
    Call loopthroughs
    Call spit
Next r

一切都很好。感谢您在运行诊断方面的所有帮助！