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数组的相关元素

e.g。 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