VBA数组维度导致运行时错误9用于模拟应用程序

我正在模拟时间事件数据，这些事件数据需要一些事件启动时的“记忆”，以便在此时应用威布尔函数。 这需要大量的值matrix，我对VBA解决scheme感兴趣，以避免在工作表上进行大量的条件和数组计算。 目前的解决scheme是创build一个包含数据的matrix，并将其乘以包含感兴趣的对angular线的matrix，然后求和产品以获得对angular线。 表格上的matrix是1800×1800。

以下代码在matrix乘法过程中出现错误，并给出了“范围”消息的“运行时间错误”9'下标。 我发现'array_2' – 尽pipe被指定为array_2（1,1） – 显示为1的下界和2的上界（参见底部附近的代码块以供论证）。

任何帮助，为什么这是发生将不胜感激。

托德

Sub sum_diag_float() Dim a, b, q, i, j, x, y, lb, ub, sum As Double Dim array_1(), array_2(), upright_arr(), array_product() As Variant ReDim array_1(0 To 9, 0 To 9) As Variant 'create data For a = 0 To 9 For b = 0 To 9 array_1(a, b) = WorksheetFunction.RandBetween(0, 10) Next b Next a Range("A1:J10").Value = array_1 For q = 1 To 1 ReDim array_2(q, q) As Variant array_2 = Range(Cells(1, 1), Cells(q + 1, q + 1)).Value Range(Cells(1, 12), Cells(2, 13)).Value = array_2 'check array specification 'build binary matrix (0/1) from lower left to upper right ReDim upright_arr(q, q) As Variant For i = LBound(upright_arr, 1) To UBound(upright_arr, 1) For j = LBound(upright_arr, 2) To UBound(upright_arr, 2) If UBound(upright_arr, 2) = i + j Then upright_arr(i, j) = 1 Else upright_arr(i, j) = 0 End If Next j Next i Range(Cells(4, 12), Cells(5, 13)).Value = upright_arr 'check matrix specification 'multiply data by the matrix ReDim array_product(q, q) As Variant For x = LBound(upright_arr, 1) To UBound(upright_arr, 1) For y = LBound(upright_arr, 2) To UBound(upright_arr, 2) array_product(x, y) = upright_arr(x, y) * array_2(x, y) Next y Next x Range(Cells(7, 12), Cells(8, 13)).Value = array_product 'matrix multiplication result sum = WorksheetFunction.sum(array_product) Range("N9").Value = sum 'sum of matrix lb = LBound(array_2, 1) 'proof of array dimension misspecification Range("L11").Value = lb ub = UBound(array_2, 1) Range("L12").Value = ub lb = LBound(array_2, 2) Range("L14").Value = lb ub = UBound(array_2, 2) Range("L15").Value = ub Next q End Sub 

第一个build议之后的编辑代码保留了运行时错误“13”：

 Sub sum_diag_float() Dim a As Byte, b As Byte Dim q As Double, i As Double, j As Double, x As Double, y As Double Dim lb As Double, ub As Double, sum As Double Dim array_1() As Double, array_2() As Double, upright_arr() As Double, array_product() As Double ReDim array_1(0 To 9, 0 To 9) As Double 'create data For a = 0 To 9 For b = 0 To 9 array_1(a, b) = WorksheetFunction.RandBetween(0, 10) Next b Next a Range("A1:J10").Value = array_1 For q = 1 To 2 ReDim array_2(q, q) As Double array_2 = Range(Cells(1, 1), Cells(q + 1, q + 1)).Value 'put cells in array Range(Cells(1, 12), Cells(1 + q, 12 + q)).Value = array_2 'check array 'build binary matrix (0/1) from lower left to upper right ReDim upright_arr(LBound(array_2, 1) To UBound(array_2, 1), LBound(array_2, 2) _ To UBound(array_2, 2)) As Double For i = LBound(array_2, 1) To UBound(array_2, 1) For j = LBound(array_2, 2) To UBound(array_2, 2) If UBound(upright_arr, 2) = i + j - 1 Then upright_arr(i, j) = 1 Else upright_arr(i, j) = 0 End If Next j Next i Range(Cells(5, 12), Cells(5 + q, 12 + q)).Value = upright_arr 'multiply data by the matrix ReDim array_product(LBound(array_2, 1) To UBound(array_2, 1), LBound(array_2, 2) _ To UBound(array_2, 2)) As Double For x = LBound(array_2, 1) To UBound(array_2, 1) For y = LBound(array_2, 2) To UBound(array_2, 2) array_product(x, y) = upright_arr(x, y) * array_2(x, y) Next y Next x Range(Cells(9, 12), Cells(9 + q, 12 + q)).Value = array_product sum = WorksheetFunction.sum(array_product) Range("O12").Value = sum 'sum of matrix Next q End Sub 

在纠正上述问题之后，在以下代码中使用时，数组乘法步骤会错误地出现运行时错误“13”。 我相信某些variables在通过第一个子元素调用两次时没有被擦除。 在阅读各种文档时，我不相信我应该为调用“sum_diag_float”提供任何值，但这可能是问题所在。 最终，子call_txp_surv将在其他循环内被调用，以创build所需的模拟数据，因此需要子工作而无需debugging即使调用了多less次。 我注意到q = 1000（s = 1000）的call_txp_surv不会产生错误，但在q = 1800和s = 1800时，运行时间为13。 现在的代码包含了与之前的代码不同的实现的单元计数（非常大，因此没有模拟数据）。 variables/计数器已被重新命名以避免与其他人发生冲突。 任何想法，为什么这个macros不会扩大，将不胜感激。

 Sub call_txp_surv() Dim lvad_clvad As Byte For lvad_clvad = 1 To 2 If lvad_clvad = 1 Then Worksheets("LVAD>TXP>death").Activate Else Worksheets("cLVAD>TXP>death").Activate End If Call sum_diag_float Next lvad_clvad End Sub Sub sum_diag_float() Application.Calculation = xlManual Application.ScreenUpdating = False Dim a As Byte, b As Byte Dim m As Long, n As Long, q As Long, x As Long, y As Long Dim array_1() As Double, array_2() As Variant, upright_arr() As Variant, array_product() As Variant 'cycle living calculation For q = 1 To 1800 'put cells into array array_2 = Range(Cells(3, 20), Cells(3 + q, 20 + q)).Value 'build binary matrix (0/1) from lower left to upper right ReDim upright_arr(LBound(array_2, 1) To UBound(array_2, 1), LBound(array_2, 2) To UBound(array_2, 2)) As Variant For m = LBound(array_2, 1) To UBound(array_2, 1) For n = LBound(array_2, 2) To UBound(array_2, 2) If UBound(upright_arr, 2) = m + n - 1 Then upright_arr(m, n) = 1 Else upright_arr(m, n) = 0 End If Next n Next m 'multiply data by the matrix ReDim array_product(LBound(array_2, 1) To UBound(array_2, 1), LBound(array_2, 2) To UBound(array_2, 2)) As Variant For x = LBound(array_2, 1) To UBound(array_2, 1) For y = LBound(array_2, 2) To UBound(array_2, 2) array_product(x, y) = upright_arr(x, y) * array_2(x, y) Next y Next x 'Range(Cells(9, 12), Cells(9 + q, 12 + q)).Value = array_product 'matrix multiplication result sum = WorksheetFunction.sum(array_product) Cells(4 + q, 1821).Value = sum 'sum of matrix Next q 'cycle deaths Dim c As Long, d As Long, s As Long, t As Long, u As Double, diff As Double s = 1801 'subtract For c = 1 To s For d = 1 To (s - c) diff = Cells(2 + d, 19 + c).Value - Cells(3 + d, 19 + c).Value Cells(4 + d + (c - 1), 1823 + c).Value = diff Next d Next c 'sum For t = 1 To (s - 1) u = WorksheetFunction.sum(Range(Cells(4 + t, t + 1823), Cells(4 + t, t + 1824))) Cells(4 + t, 1822).Value = u Next t Application.Calculation = xlAutomatic Application.ScreenUpdating = True End Sub 

Answer 1

你的代码行：

 ReDim array_2(q, q) As Variant 

维度为array_2（0到1,0到1）

但是接下来你的下一行：

 array_2 = Range(Cells(1, 1), Cells(q + 1, q + 1)).Value 

实际上是将array_2重新设置为（1到2，1到2）（两行和两列）（行数为1，列数为2）。

当你设置一个数组等于一系列的单元格时，会发生这种情况。

如果要保留0到1的维度，则必须循环遍历单元格并专门指定它们。

请参阅Chip Pearson在VBA中的“数组和范围”

另外，你的路线：

 Dim a, b, q, i, j, x, y, lb, ub, sum As Double 

将所有variables（除了总和）声明为Variants。 鉴于你的代码，我不知道他们是否应该被宣布为长。

编辑：关于你编辑的代码，我不明白你为什么做了你所做的。

• 在上面贴到Chip Pearson网站的链接中，清楚地表明，当你设置一个等于一个范围的数组时，数组应该被声明为Varianttypes; 你已经声明它是Double（两次！），所以Type Mismatch错误。 再一次，如果你必须有Doubletypes的数组，那么你将不得不循环并逐一赋值。

• 由于我上面写的原因， ReDim array_2行增加开销，没有完成任何事情，应该被删除。

• 为什么你声明你的计数器是Doubletypes而不是Longtypes？

Answer 2

下面是我的问题的工作和testing代码。 感谢罗恩的帮助。

 Sub sum_diag_float() Dim a As Byte, b As Byte Dim q As Long, i As Long, j As Long, x As Long, y As Long Dim array_1() As Double, array_2() As Variant, upright_arr() As Double, array_product() As Double ReDim array_1(0 To 9, 0 To 9) As Double 'create data For a = 0 To 9 For b = 0 To 9 array_1(a, b) = WorksheetFunction.RandBetween(0, 10) Next b Next a Range("A1:J10").Value = array_1 For q = 1 To 2 array_2 = Range(Cells(1, 1), Cells(q + 1, q + 1)).Value 'put cells in array Range(Cells(1, 12), Cells(1 + q, 12 + q)).Value = array_2 'check array specification 'build binary matrix (0/1) from lower left to upper right ReDim upright_arr(LBound(array_2, 1) To UBound(array_2, 1), LBound(array_2, 2) To UBound(array_2, 2)) As Double For i = LBound(array_2, 1) To UBound(array_2, 1) For j = LBound(array_2, 2) To UBound(array_2, 2) If UBound(upright_arr, 2) = i + j - 1 Then upright_arr(i, j) = 1 Else upright_arr(i, j) = 0 End If Next j Next i Range(Cells(5, 12), Cells(5 + q, 12 + q)).Value = upright_arr 'check matrix specification 'multiply data by the matrix ReDim array_product(LBound(array_2, 1) To UBound(array_2, 1), LBound(array_2, 2) To UBound(array_2, 2)) As Double For x = LBound(array_2, 1) To UBound(array_2, 1) For y = LBound(array_2, 2) To UBound(array_2, 2) array_product(x, y) = upright_arr(x, y) * array_2(x, y) Next y Next x Range(Cells(9, 12), Cells(9 + q, 12 + q)).Value = array_product 'matrix multiplication result sum = WorksheetFunction.sum(array_product) Range("O12").Value = sum 'sum of matrix Next q End Sub