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

Question

我可以将数组添加在一起以进行输出吗？

代码确实与 header 匹配并将值返回到各种数组。 当我尝试输出数组并将值加在一起时，我得到

type mismatch

上线

.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

Answer 1

矩阵乘法方法

要将 2 个一维数组相加，您可以执行以下数学技巧，并使用 WorksheetFunction.MMult method 将 4 个数组的数组与 Array(1, 1, 1, 1) 相乘结果是 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

由于 matrix multiplication rules，这就是矩阵 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