Option Explicit

Sub tt()
      Dim a(), i&, t$, d1 As Object, d2 As Object, k
      a = Selection.Value
      Set d1 = CreateObject("scripting.dictionary"): d1.comparemode = 1
      Set d2 = CreateObject("scripting.dictionary"): d2.comparemode = 1

      For i = 1 To UBound(a)
          t = Trim(a(i, 1)) & "|" & Trim(a(i, 2))
          If Len(t) > 1 Then
              d1.Item(t) = IIf(Len(Trim(a(i, 3))), d1.Item(t) & "+" & Trim(a(i, 3)), d1.Item(t))
              d2.Item(t) = IIf(Len(Trim(a(i, 4))), d2.Item(t) & "+" & Trim(a(i, 4)), d2.Item(t))
          End If
      Next
      With Sheets("Результат")
          .UsedRange.Offset(1).Clear
          i = 1
          For Each k In d1.keys
              i = i + 1
              .Cells(i, 1).Resize(, 2) = Split(k, "|")
              .Cells(i, 3) = Mid(d1.Item(k), 2)
              .Cells(i, 4) = Mid(d2.Item(k), 2)
          Next
      End With

End Sub