将数组添加到一起(在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

Answer 1

矩阵乘法的方法

要添加2个1维数组,您可以执行以下数学技巧,并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