先前乘法后的VBA矩阵加法

时间:2018-07-31 05:27:53

标签: excel vba excel-vba

在我通过矩阵乘法收到两个矩阵之一之后,我想添加两个矩阵。我要计算的公式为:((TS x TI)+ TI)x PK = TK

Dim TS_Matrix As Variant, TI_Matrix As Variant, Dummy_Matrix As Variant, PK_Matrix As Variant, TK_Matrix As Variant

'Read matrices
TS_Matrix = Worksheets(1).Range("B2:E5")
TI_Matrix = Worksheets(2).Range("B2:E5")
PK_Matrix = Worksheets(3).Range("B2:B5")

'Calculation
Dummy_Matrix = Application.MMult(TS_Matrix, TI_Matrix)
Dummy_Matrix = Dummy_Matrix + TI_Matrix
TK_Matrix = Application.MMult(Dummy_Matrix, PK_Matrix)

'Write
Worksheets(4).Range("B2:B5") = TK_Matrix

没有添加,它可以完美运行。我如何解决它?以下行给我一个

  

运行时错误“ 13”:键入不匹配。

Dummy_Matrix = Dummy_Matrix + TI_Matrix

提前谢谢!

1 个答案:

答案 0 :(得分:1)

您不能添加2个像这样的Dummy_Matrix = Dummy_Matrix + TI_Matrix矩阵,因为VBA不支持直接添加2个数组。取而代之的是,您需要遍历数组的所有元素,以逐个添加每个元素。

这里是一个例子:

Option Explicit

Public Sub TestMatrixAdd()
    Dim MatrixA As Variant
    Dim MatrixB As Variant
    Dim MatrixOut As Range 'note output must be a range

    With Worksheets("Sheet1") 'adjust to your sheet
        MatrixA = .Range("A1:B5")
        MatrixB = .Range("D1:E5")
        Set MatrixOut = .Range("G1:H5")
    End With

    MatrixOut = AddMatrices(MatrixA, MatrixB)
End Sub


Public Function AddMatrices(MatrixA As Variant, MatrixB As Variant) As Variant
    'matrices must be of the same size
    If LBound(MatrixA, 1) <> LBound(MatrixB, 1) Or _
       LBound(MatrixA, 2) <> LBound(MatrixB, 2) Or _
       UBound(MatrixA, 1) <> UBound(MatrixB, 1) Or _
       UBound(MatrixA, 2) <> UBound(MatrixB, 2) Then
        GoTo SIZE_ERROR
    End If


    Dim MatrixOut As Variant
    ReDim MatrixOut(LBound(MatrixA, 1) To UBound(MatrixA, 1), LBound(MatrixA, 2) To UBound(MatrixA, 2))

    'matrix addition
    Dim i As Long, j As Long
    For i = LBound(MatrixA, 1) To UBound(MatrixA, 1)
        For j = LBound(MatrixA, 2) To UBound(MatrixA, 2)
            MatrixOut(i, j) = MatrixA(i, j) + MatrixB(i, j)
        Next j
    Next i

    AddMatrices = MatrixOut

    Exit Function
SIZE_ERROR:
    AddMatrices = "Matrices must be of the same size"
End Function

enter image description here