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

Question

I'n new to vba and trying to write some code to do some operations on an array.

Presently just trying to do straight forward multiplication to make sure I am writing the code correctly but unfortunately I keep receiving the following error.

Run time error '9': Subscript out of range

My code is as follows:

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

Unfortunately I am unable to spot the error, as the array size should be correct.

Basically user first selects 2D array eg 24 Rows, 5 Cols, then user selects 1D array of 24Rows.

I then want to output another array where each element of the 2D array is multiplied by the relevant element of the 1D array

eg 2D array all 5 columns of row 1 multipled by row 1 of 1D array etc.

I hope the above is clear any help or pointers would be greatly appreciated.

Thanks

Answer 1

Your code had many problems. Here is a working version of matrix to vector multiplication:

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

The above can also be accomplished by

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

After reading your responses I went back and edited my code, which now works for the mulitplication.

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

This code will ultimately be edited so that I can residistribute residuals across the variables of a regression based on the percentage each variable contributes in each observation.

So now I have to figure out how to sum all columns in each row, then divide each element by this sum to get a percentage eg each row will be 100%. The multiply this by the residual and add back to the variable.

When I have this done I will repost but there may be many more questions before then.

Thanks again, dctb13