excel - 将数组添加在一起（在 VBA 中）以进行输出

Question

我可以将数组添加到一起输出吗？

该代码确实与标题匹配并将值返回到各种数组。当我尝试输出我的数组并将这些值相加时，我得到

类型不匹配

在线的

.Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = Application.Transpose(R) + Application.Transpose(M) + Application.Transpose(O) + Application.Transpose(Q)

在以下代码中：

Const FirstMatch As Boolean = True
Dim SR As Variant
Dim OAS As Variant
Dim iSR As Integer
Dim iOAS As Integer
Dim R As Variant
Dim M As Variant
Dim O As Variant
Dim Q As Variant
Dim headers As Variant
Dim iheaders As Integer

SR = Worksheets("Sheet A").Range("D3:J7").Value  ' Array for CS01 Data
OAS = Worksheets("Sheet A").Range("D28:J35").Value 'Array for MBS Data
headers = Worksheets("Sheet B").Range("B1:H1").Value

With Worksheets("Sheet B")
    ReDim R(1 To UBound(SR, 2), 1 To 1)
    ReDim M(1 To UBound(SR, 2), 1 To 1)
    ReDim O(1 To UBound(SR, 2), 1 To 1)
    ReDim Q(1 To UBound(SR, 2), 1 To 1)

    For iheaders = 1 To UBound(headers, 2)
        For iSR = 1 To UBound(SR, 2)
            If headers(1, iheaders) = SR(1, iSR) Then
                R(iSR, 1) = SR(5, iSR)
                If FirstMatch Then
                    Exit For
                End If
            End If
        Next

        For iOAS = 1 To UBound(OAS, 2)
            If headers(1, iheaders) = OAS(1, iOAS) Then
                M(iOAS, 1) = OAS(6, iOAS)
                O(iOAS, 1) = OAS(7, iOAS)
                Q(iOAS, 1) = OAS(8, iOAS)
                If FirstMatch Then
                    Exit For
                End If
            End If
        Next
    Next

    .Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = Application.Transpose(R) + Application.Transpose(M) + Application.Transpose(O) + Application.Transpose(Q)
End With

标签： excelvba

Answer 1

矩阵乘法的方法

要将 2 个一维数组相加，您可以执行以下数学技巧，并Array(1, 1, 1, 1)使用WorksheetFunction.MMult 方法将 4 个数组的数组乘以 4 个数组的总和（由于矩阵乘法规则）：

Option Explicit

Public Sub AddArrays()
    Dim arr1 As Variant, arr2 As Variant, arr3 As Variant, arr4 As Variant
    arr1 = Array(1, 3, 5, 5)
    arr2 = Array(4, 0, 9, 1)
    arr3 = Array(1, 2, 3, 4)
    arr4 = Array(4, 3, 2, 1)
    'result     10, 8, 19, 11

    Dim MultArr As Variant
    MultArr = Array(1, 1, 1, 1)  'a 1 for every arr variable that you sum (4 arrays = 4 ones)

    Dim ResultArr As Variant
    ResultArr = Application.WorksheetFunction.MMult(MultArr, Array(arr1, arr2, arr3, arr4))

    'just an output example:
    Debug.Print Join(ResultArr, ", ")
End Sub

由于矩阵乘法规则，这就是它如何将矩阵MultArr与由 组成的矩阵相乘arr1 … arr4，这与添加 的结果相同arr1 … arr4：

由于在您的问题中，二维数组ReDim R(1 To UBound(SR, 2), 1 To 1)几乎是一维的，因此可以将它们简化为ReDim R(1 To UBound(SR, 2))填充的一维数组R(iSR) = SR(5, iSR)，您可以轻松地使用上面的技巧对它们求和：

.Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = Application.WorksheetFunction.MMult(Array(1, 1, 1, 1), Array(R, M, O, Q))

使用循环方法

正如 chris neilsen 提到的，上面显示的方法比循环慢了大约 8 倍，我建议如下：

由于在您的问题中，二维数组ReDim R(1 To UBound(SR, 2), 1 To 1)几乎是一维的，因此可以将它们简化为一维数组，这样更容易处理ReDim R(1 To UBound(SR, 2))填充R(iSR) = SR(5, iSR)

你可以通过一个循环来总结它们

Dim RestultArr As Variant
ReDim ResultArr(1 To UBound(SR, 2))

Dim i As Long
For i = LBound(ResultArr) To UBound(ResultArr)
    ResultArr(i) = R(i) + M(i) + O(i) + Q(i)
Next i

并将其写入您的范围

.Range("B" & lastrow + 1 & ":" & "H" & lastrow + 1).Value = ResultArr