Option Explicit

Sub mySum()
    Dim sh As Worksheet
    Set sh = ActiveSheet
    Dim arr As Variant
    arr = sh.UsedRange.FormulaR1C1
    ClearArray arr
    
    Dim dicY As Object
    Dim dicX As Object
    GetDic arr, dicY, dicX
    
    If dicY.Count = 0 Then Exit Sub
    If dicX.Count = 0 Then Exit Sub
    
    Dim yy As Long
    Dim yd As Long
    Dim yo As Long
    Dim xx As Long
    Dim xo As Long
    For yy = dicY.Items()(dicY.Count - 1) + 1 To UBound(arr, 1)
        If arr(yy, 3) = "Итог" Then
            yd = yy
        Else
            If yd > 0 Then
                If dicY.Exists(arr(yy, 2)) Then
                    yo = dicY.Item(arr(yy, 2))
                    
                    For xx = 4 To UBound(arr, 2)
                        If dicX.Exists(arr(yd, xx)) Then
                            xo = dicX.Item(arr(yd, xx))
                            If IsEmpty(arr(yo, xo)) Then
                                arr(yo, xo) = "=R" & yy & "C" & xx
                            Else
                                arr(yo, xo) = arr(yo, xo) & "+R" & yy & "C" & xx
                            End If
                        End If
                    Next
                End If
            End If
        End If
    Next
    
    sh.UsedRange.FormulaR1C1 = arr
End Sub

Private Sub GetDic(arr As Variant, dicY As Object, dicX As Object)
    Set dicY = CreateObject("Scripting.Dictionary")
    Set dicX = CreateObject("Scripting.Dictionary")
            
    Dim yy As Long
    For yy = 1 To UBound(arr, 1)
        If arr(yy, 3) = "Итог" Then Exit For
    Next
    If yy < UBound(arr, 1) Then
        Dim uu As Long
        For uu = yy + 1 To UBound(arr, 1)
            If arr(uu, 3) = "Итог" Then Exit For
        Next
        If uu < UBound(arr, 1) Then
            Dim ii As Long
            Dim xx As Long
            For ii = yy + 1 To uu - 1
                If arr(ii, 2) <> "" Then
                    dicY.Item(arr(ii, 2)) = ii
                    
                    For xx = 4 To UBound(arr, 2)
                        arr(ii, xx) = Empty
                    Next
                End If
            Next
        
            For ii = 4 To UBound(arr, 2)
                If arr(yy, ii) <> "" Then
                    dicX.Item(arr(yy, ii)) = ii
                End If
            Next
        End If
    End If
End Sub

Private Sub ClearArray(arr As Variant)
    Dim xx As Long
    Dim yy As Long
    For yy = 1 To UBound(arr, 1)
        For xx = 1 To UBound(arr, 2)
            If IsError(arr(yy, xx)) Then arr(yy, xx) = Empty
        Next
    Next
End Sub