如何基于第一行和第一列中的值求和一系列矩阵-Excel VBA

如何解决如何基于第一行和第一列中的值求和一系列矩阵-Excel VBA

我有一系列5x5矩阵（总共20个），我需要创建一个全局矩阵，该矩阵基于第一行和第一列的相应值将矩阵的4x4部分相加。请参考下图。

https://i.stack.imgur.com/xUAEL.png

框式4x4矩阵是我需要求和的元素。

全局矩阵将是与第一行和第一列匹配的所有相应值的总和。例如，在上面的图像中，来自k1和k2的值加在一起将是与 10,10（两个4x4矩阵的左上角），即0.000 + 0.010。矩阵k3和k4没有10,10像元，因此这些矩阵不会添加任何值。

因此全局矩阵看起来与下图类似（请注意矩阵不完整）。

https：//i.s

此处的图像描述] 3] 3 如果可能的话，我想编写一个可以执行此操作的宏，以免我不得不手动执行此操作。我已经尝试了一些匹配函数，但是鉴于我的新手编码能力，它似乎无法解决任何问题。

任何建议将不胜感激。

解决方法

将结果预先放入数组后，可以根据索引号添加每个区域的内容。

Sub test()
    Dim vResult(1 To 20,1 To 20)
    Dim vDB As Variant
    Dim rngTable As Range
    Dim rng As Range
    Dim i As Integer,j As Integer
    
    '5x5 Matrix first cell
    Set rngTable = Range("d2,d10,L2,L10") '<~~ Add more first cells from another table.
    
    For Each rng In rngTable
        vDB = rng.Resize(5,5)
        For i = 2 To 5
            For j = 2 To 5
                vResult(vDB(i,1),vDB(1,j)) = vResult(vDB(i,j)) + vDB(i,j)
            Next j
        Next i
    Next rng
    
    'Result Matrix
    'The result is displayed based on cell e19,but if the cell position is adjusted,the result is displayed in another cell.
    Range("e19").Resize(UBound(vResult,UBound(vResult,2)) = vResult

End Sub

图片

,

求和矩阵

• 仔细调整常量部分中的值。

代码

Option Explicit

Sub sumMatrices()
    ' Source
    Const srcName As String = "Sheet1"
    Const srcFirstCell As String = "A1"
    Const hGap As Long = 2
    Const vGap As Long = 2
    Const hCount As Long = 10
    Const vCount As Long = 2
    Const hSize As Long = 5
    Const vSize As Long = 5
    ' Target
    Const tgtName As String = "Sheet2"
    Const tgtFirstCell As String = "B2"
    Const hMax As Long = 20
    Const vMax As Long = 20
    ' Other
    Dim wb As Workbook
    Set wb = ThisWorkbook ' The workbook containing this code.
    
    ' Define first Source Range.
    Dim src As Worksheet
    Set src = wb.Worksheets(srcName)
    Dim rng As Range
    Set rng = src.Range(srcFirstCell).Resize(hSize,vSize)
    
    ' Write values from Source Ranges to arrays of Jagged Source Array.
    
    Dim Source As Variant
    ReDim Source(1 To hCount * vCount)
        
    Dim hOffs As Long
    Dim vOffs As Long
    hOffs = hSize + hGap
    vOffs = vSize + vGap
    
    Dim hCurr As Long
    Dim vCurr As Long
    Dim i As Long
    Dim j As Long
    Dim l As Long
    
    For i = 1 To hCount
        hCurr = (i - 1) * hOffs
        For j = 1 To vCount
            vCurr = (j - 1) * vOffs
            l = l + 1
            Source(l) = rng.Offset(hCurr,vCurr).Value
        Next j
    Next i
    
    ' Write values from arrays of Jagged Source Array to Target Array.
    Dim Target As Variant
    ReDim Target(1 To hMax,1 To vMax)
    
    For l = 1 To UBound(Source)
        For i = 2 To hSize
            For j = 2 To vSize
                Target(Source(l)(i,Source(l)(1,j)) _
                  = Target(Source(l)(i,j)) _
                  + Source(l)(i,j)
            Next j
        Next i
    Next l
    
    ' Write values from Target Array to Target Range.
    Dim tgt As Worksheet
    Set tgt = wb.Worksheets(tgtName)
    tgt.Range(tgtFirstCell).Resize(hMax,vMax).Value = Target
    
    ' Inform user.
    MsgBox "Data transferred.",vbInformation,"Success"

End Sub