我正在使用时间到事件的数据进行模拟，这需要一些事件开始时的“记忆”才能在那时应用Weibull函数。这需要一个大的值矩阵，我对VBA解决方案感兴趣，以避免在工作表上进行大量的条件和数组计算。当前的解决方案是创建一个包含数据的矩阵，然后将其乘以一个包含感兴趣对角线的矩阵，然后对乘积求和以获得单独的对角线。在工作表上的矩阵为1800x1800。
下面的代码在矩阵乘法过程中似乎出现故障，并给出“范围的运行时错误'9'下标”消息。我发现'array_2'-尽管被指定为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
遵循第一个建议的已编辑代码将保留运行时错误'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”。我相信通过第一个子调用两次时，某些变量不会被擦除。在阅读各种文档时，我并不相信我必须为“ sum_diag_float”的调用提供任何值，但这可能是问题所在。最终，子“ call_txp_surv”将在其他循环中被调用以创建所需的仿真数据，因此，尽管调用了该子多次，但仍需要该子在没有错误的情况下工作。我注意到q = 1000（s = 1000）的call_txp_surv不会产生错误，但是在q = 1800和s = 1800时会发生运行时'13'。该代码现在包含已实现的单元数，该计数与以前的代码不同（大得多，因此没有模拟数据）。变量/计数器已重命名以避免与其他变量/计数器冲突。关于为何此宏无法按比例放大的任何想法，将不胜感激。
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
您的代码行：
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的尺寸，则必须遍历单元格并进行专门分配。
顺便说一句，您的行：
Dim a, b, q, i, j, x, y, lb, ub, sum As Double
将除sum之外的所有变量声明为Variants。给定您的代码，我想知道是否应将它们声明为Long。
编辑：关于您编辑的代码，我不明白您为什么做您所做的事情。
在我上面发布到Chip Pearson网站的链接中，该链接清楚地表明，当您将数组设置为等于范围时，应将数组声明为Variant类型。您已将其声明为Double（两次！），因此类型不匹配错误。同样，如果必须将数组的类型设置为Double，则必须循环遍历并一一分配值。
由于上述原因，ReDim array_2行增加了开销，但未完成任何事情，应将其删除。
为什么将计数器声明为Double类型而不是Long类型？
本文收集自互联网，转载请注明来源。
如有侵权，请联系[email protected] 删除。
我来说两句