Question

我在VBA代码中遇到了特殊情况。代码使用表中的数据填充数组myArray，而不是多次粘贴数组，每次迭代编辑数据两列并粘贴。

以下代码成功执行，但始终以＆＃34;运行时错误＆＃39; 9＆＃39;：下标超出范围＆＃34;。

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

一切顺利。感谢您运行诊断程序的所有帮助！

循环成功，但结束于＆＃34;下标超出范围＆＃34;

2 个答案: