VBA：将2D随机数乘以1D数组收到运行时错误

Question

我是vba的新手，正在尝试编写一些代码对数组进行一些操作。

目前，只是尝试进行直接乘法以确保我正确地编写了代码，但不幸的是，我一直收到以下错误。

Run time error '9': Subscript out of range

我的代码如下：

Sub ArrayOp()
Dim rng As Range
Dim rng2 As Range
Dim Destination As Range

Dim numRows As Integer
Dim numCols As Integer

Dim ArrRng As Variant
Dim ArrRng2 As Variant
Dim myarray As Variant

Set rng = Application.InputBox("Select variable data", "Obtain Range Object", Type:=8)
Set rng2 = Application.InputBox("Select residuals", "Obtain Range Object", Type:=8)
Set Destination = Application.InputBox("Select starting location for output", "Obtain Range Object", Type:=8)

ArrRng = rng
ArrRng2 = rng2

numRows = UBound(ArrRng, 1) - LBound(ArrRng, 1) + 1
numCols = UBound(ArrRng, 2) - LBound(ArrRng, 2) + 1

ReDim myarray(numRows, numCols)

For i = 1 To numRows
    For j = 1 To numCols
        myarray(i, j) = ArrRng(i, j) + ArrRng2(i)
    Next j
Next i

Destination.Resize(UBound(myarray, 1), UBound(myarray, 2)).Value = myarray 


End Sub

不幸的是，由于数组大小正确，我无法发现错误。

基本上，用户首先选择2D数组，例如24行，5列，然后用户选择24行的1D数组。

然后，我想输出另一个数组，其中2D数组的每个元素都乘以1D数组的相关元素

例如2D数组，第1行的所有5列乘以1D数组的第1行，依此类推。

我希望以上内容很清楚，对您的帮助或指点将不胜感激。

谢谢

Answer 1

您的代码有很多问题。 这是矩阵到向量乘法的工作版本：

Sub ArrayOp()
Dim rng As Range
Dim rng2 As Range
Dim Destination As Range

Dim numRows As Integer
Dim numCols As Integer

Dim ArrRng As Variant
Dim ArrRng2 As Variant
Dim myarray As Variant

Set rng = Application.InputBox("Select variable data", "Obtain Range Object", Type:=8)
Set rng2 = Application.InputBox("Select residuals", "Obtain Range Object", Type:=8)
Set Destination = Application.InputBox("Select starting location for output", "Obtain Range Object", Type:=8)

ArrRng = rng.Value
ArrRng2 = rng2.Value
numRows = rng.Rows.Count
numCols = rng.Columns.Count
If numCols <> rng2.Rows.Count Then
    MsgBox "Inconsistent Matrix Columns with Vector Rows", vbCritical, "Multiplication"
    Exit Sub
End If
ReDim myarray(1 To numRows, 1 To 1)
Dim i As Integer, j As Integer
Dim sum As Double
For i = 1 To numRows
    sum = 0#
    For j = 1 To numCols
        sum = sum + ArrRng(i, j) * ArrRng2(j, 1)
    Next j
    myarray(i, 1) = sum
Next i
Destination.Resize(numRows, 1).Value = myarray    
End Sub

以上也可以通过

Sub ArrayOp2()
Dim rng As Range
Dim rng2 As Range
Dim Destination As Range

Set rng = Application.InputBox("Select variable data", "Obtain Range Object", Type:=8)
Set rng2 = Application.InputBox("Select residuals", "Obtain Range Object", Type:=8)
Set Destination = Application.InputBox("Select starting location for output", "Obtain Range Object", Type:=8)

Destination.Resize(rng.Rows.Count,1).Value = WorksheetFunction.MMult(rng, rng2)

End Sub

Answer 2

阅读您的回复后，我回过头来编辑了我的代码，该代码现在可用于多重复制。

Option Base 1
Sub ArrayOp()
Dim rng As Range
Dim rng2 As Range
Dim Destination As Range

Dim numRows As Integer
Dim numCols As Integer

Dim ArrRng As Variant
Dim ArrRng2 As Variant
Dim myarray As Variant

Set rng = Application.InputBox("Select variable data", "Obtain Range Object", Type:=8)
Set rng2 = Application.InputBox("Select residuals", "Obtain Range Object", Type:=8)
Set Destination = Application.InputBox("Select starting location for output", "Obtain Range Object", Type:=8)

ArrRng = rng
ArrRng2 = rng2

numRows = rng.Rows.Count
numCols = rng.Columns.Count

ReDim myarray(numRows, numCols)

If numRows <> rng2.Rows.Count Then
    MsgBox "Please make sure the same number of observations are available for the residuals and the variables", vbCritical, "Multiplication"
    Exit Sub
End If

For i = 1 To numRows
    For j = 1 To numCols
        myarray(i, j) = ArrRng(i, j) * ArrRng2(i, 1)
    Next j
Next i

Destination.Resize(UBound(myarray, 1), UBound(myarray, 2)).Value = myarray


End Sub

最终将对该代码进行编辑，以便我可以根据每个变量在每个观察值中所占的百分比在回归变量之间重新分配残差。

因此，现在我必须弄清楚如何对每一行中的所有列求和，然后将每个元素除以该总和以获得百分比，例如，每一行将为100％。 将此乘以残差，然后加回到变量中。

完成此操作后，我将重新发布，但在此之前可能还会有更多问题。

再次感谢，dctb13