如何根据第一行和第一列中的值对一系列矩阵求和 - Excel VBA

Question

I have a series of 5x5 matrices (20 total) and I need to create a global matrix that sums the 4x4 sections of the matrices based on the corresponding values of the first row and column. Refer image below.

https://i.stack.imgur.com/xUAEL.png The boxed 4x4 matrices are the elements that I need to sum.

The global matrix will be the sum of all of the corresponding values that match the first row and column. For example, in the image above, the values from k1 and k2 that get added together will be the cells corresponding to 10,10 (top left for both 4x4 matrices), which is 0.000 + 0.010. The matrices k3 and k4 don't have a 10,10 cell, so no values will be added from these matrices.

So the global matrix will look similar to the below image (note the matrix is incomplete).

https://is mage description here] 3 ] 3 If possible, I'd like to write a macro that can do this in order to save me having to do it manually. I've tried a couple of match functions but can't seem to get anywhere with it given my novice coding ability.

Any suggestions would be greatly appreciated.

Answer 1

After making the result into an array in advance, you can add the contents of each area according to the index number.

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, 1), vDB(1, 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, 1), UBound(vResult, 2)) = vResult

End Sub

Image

Answer 2

Sum Matrices

• Carefully adjust the values in the constants section.

The Code

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, 1), Source(l)(1, j)) _
                  = Target(Source(l)(i, 1), Source(l)(1, 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