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