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个一维数组，您可以执行以下数学技巧，并使用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相加的结果相同：< / p>

由于在您的问题中二维数组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

Answer 2

否，VBA不支持对数组进行矢量操作。您只需要遍历数组中的所有值，将它们一起添加到新的输出数组中，然后将范围值设置为新数组即可。

Answer 3

问题中发布的原始代码对…下一个和数组使用过多，建议使用Match函数来标识字段位置并按字段对所需值求和，然后再将它们添加到数组中，然后发布结果数组

据我了解的问题的要求：

要在工作表D3:J7中将范围D28:J35中第5行中的值以及范围Sheet A中第6、7和8行中的值相加，因为它们与范围{中的字段相对应工作表B1:H1中的{1}}，使用每个范围的第一行来确定与工作表Sheet B中的范围B1:H1相关的字段位置。然后将工作表Sheet B中范围B1:H1下方第一个空白行中每个字段的结果值过帐。

下面的代码使用工作表函数Sheet B来标识每个范围中的字段位置，而不是遍历每个范围然后在找到每个范围中字段的位置之后，将相应的值添加到输出数组

之前的采样数据：

Match

结果：

因此，由于仅创建一个数组，因此无需添加多个数组。

请注意，在原始代码中这些行：

Sub TEST()
Dim aOutput As Variant
Dim aHdr As Variant, aSR As Variant, aOAS As Variant
Dim bHdr As Byte, bSR As Byte, bOAS As Byte
Dim lastrow

    lastrow = 1     'Value assigned for test purpose

    Rem Set Arrays
    With ThisWorkbook
        aSR = .Worksheets("Sheet A").Range("D3:J7").Value     ' Array for CS01 Data
        aOAS = .Worksheets("Sheet A").Range("D28:J35").Value  ' Array for MBS Data
        aHdr = Worksheets("Sheet B").Range("B1:H1").Value
    End With

    Rem Redimensioning Header Array
    aHdr = WorksheetFunction.Transpose(aHdr)
    aHdr = WorksheetFunction.Transpose(aHdr)

    Rem Create Output Array
    aOutput = aHdr

    Rem Fill Output Array
    For bHdr = 1 To UBound(aHdr)

        Rem Initiate Variables
        bSR = 0
        bOAS = 0
        aOutput(bHdr) = 0

        With WorksheetFunction

            Rem Get Field Position
            On Error Resume Next
            bSR = .Match(aHdr(bHdr), .Index(aSR, 1, 0), 0)
            bOAS = .Match(aHdr(bHdr), .Index(aOAS, 1, 0), 0)
            On Error GoTo 0

            Rem Add Field Values To Ouput Array
            If bSR <> 0 Then aOutput(bHdr) = aSR(5, bSR)
            If bOAS <> 0 Then aOutput(bHdr) = aOutput(bHdr) _
                + aOAS(6, bOAS) + aOAS(7, bOAS) + aOAS(8, bOAS)

    End With: Next

    Rem Post Ouput Array
    ThisWorkbook.Worksheets("Sheet B").Cells(1 + lastrow, 2) _
        .Resize(1, UBound(aOutput)).Value2 = aOutput

    End Sub

应该是：

R(iSR, 1) = SR(5, iSR) 
M(iOAS, 1) = OAS(6, iOAS) 
O(iOAS, 1) = OAS(7, iOAS) 
Q(iOAS, 1) = OAS(8, iOAS)

Answer 4

通向罗马的另一种方式...

就本领域而言，除了上面的有效解决方案之外，我还将展示一种方法，该方法如何使用一个衬套（而不是创建多个阵列）将所需的阵列部分一起修补 Application.Index函数的高级过滤功能（请参见 1b 部分）。

产生的新变体数组v被写回到'Sheet B'（请参阅 2 部分）。

此外，我展示了一些示例以获取列或行的总和（请参见 3 部分）。

代码示例

我假设数据块中的列属于相同的类别。

Option Explicit         ' declaration head of your code module

Sub AddDataBlocks()
' [1a] create 2-dim data field array (1-based)
  Dim v
  v = ThisWorkbook.Worksheets("Sheet A").Range("D3:J35").Value2
' [1b] filter rows to be maintained (omitting title row)
  Dim MyRows(): MyRows = Array(5, 31, 32, 33)
  v = Application.Transpose(Application.Index(v, MyRows, Evaluate("row(1:" & UBound(v, 2) & ")")))

' [2]  write new array back to sheet B
  Dim lastrow&: lastrow = 1
  ThisWorkbook.Worksheets("Sheet B").Range("B" & lastrow + 1).Resize(UBound(v), UBound(v, 2)) = v

' ~~> Some arithmetics in examples
' [3a] get total sum
  Dim total#, i&, j&
  For i = LBound(v) To UBound(v)
      For j = LBound(v, 2) To UBound(v, 2)
          total = total + v(i, j)
      Next j
  Next i
  Debug.Print "Total = " & total
' [3b] display a row sum, e.g. 2nd row (no iM)
  Const iR = 1, iM = 2, iO = 3, iQ = 4
  Debug.Print "M = " & WorksheetFunction.Sum(Application.Transpose(Application.Index(v, iM, 0)))
' [3c] display a column sum, e.g. 3rd column
  Debug.Print "3rd column added = " & WorksheetFunction.Sum(Application.Transpose(Application.Index(v, 0, 3)))

End Sub

将数组加在一起（在VBA中）以输出

4 个答案:

采用矩阵乘法的方法

采用循环方式