Суммирование из одинаковых ячеек

[Hugo121]

Я уже немного подзабыл - смотрю, в файле макрос чуть иначе выглядит, чем в теме...
В общем, подправил макрос в файле, плюс немного из поста взял (но рамки не ставит):

Option Explicit


Sub Otbor()
    Dim a(), oDict As Object, i As Long, temp As String, kk, rr As Range
    
    With Application
    .DisplayAlerts = False
    .ScreenUpdating = False
    Set rr = [a1:h2]

    a = Range("A3:H" & Range("A" & Rows.Count).End(xlUp).Row).Value

    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = vbTextCompare
    
    For i = 1 To UBound(a)
        temp = Application.Trim(a(i, 5) & "|" & a(i, 6) & "|" & a(i, 7))
        If Not oDict.Exists(temp) Then
            ReDim b(1 To 5)
             b(1) = a(i, 1): b(2) = a(i, 2): b(3) = a(i, 3)
             b(4) = a(i, 4): b(5) = a(i, 8)
            oDict.Add temp, b
        Else
            b = oDict.Item(temp)
            b(4) = b(4) + a(i, 4): b(5) = b(5) + a(i, 8)
            oDict.Item(temp) = b
        End If
    Next
    
    With Workbooks.Add.Sheets(1)
            rr.Copy .[a1]
            i = 2
        For Each kk In oDict.keys
        i = i + 1
        .Range("A" & i) = i - 2 'oDict.Item(kk)(1)
        .Range("B" & i) = oDict.Item(kk)(2)
        .Range("C" & i) = oDict.Item(kk)(3)
        .Range("D" & i) = oDict.Item(kk)(4)
        .Range("E" & i) = Split(kk, "|")(0)
        .Range("F" & i) = Split(kk, "|")(1)
        .Range("G" & i) = Split(kk, "|")(2)
        .Range("H" & i) = oDict.Item(kk)(5)
        Next
        .Cells(i + 1, 8).Formula = "=sum(H3:H" & i & ")"
    End With

    .DisplayAlerts = True
    .ScreenUpdating = True
    End With
End Sub