oDict1.Item(temp) = CStr(--oDict1.Item(temp) + a(i, 5))

Sub Otbor3()
    Dim a(), oDict1 As Object, oDict2 As Object, i As Long, temp As String
    On Error Resume Next

    a = Range("a1:f" & Range("A" & Rows.Count).End(xlUp).Row).Value
    Set oDict1 = CreateObject("Scripting.Dictionary")
    Set oDict2 = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(a)
        temp = UCase(Trim(a(i, 1)))
        If Not oDict1.Exists(temp) Then
            oDict1.Add temp, CStr(a(i, 3))
            oDict2.Add temp, CStr(a(i, 4))
        Else
        oDict1.Item(temp) = CStr(--oDict1.Item(temp) + a(i, 3))
        oDict2.Item(temp) = CStr(--oDict2.Item(temp) + a(i, 4))
        End If
    Next
    With Sheets("Анализ")    'ThisWorkbook.Worksheets(2)
        .Range("C1").Resize(oDict1.Count) = Application.Transpose(oDict1.keys)
        .Range("D1").Resize(oDict1.Count) = Application.Transpose(oDict1.items)
        .Range("E1").Resize(oDict1.Count) = Application.Transpose(oDict2.items)
    End With
End Sub

Sub Otbor2()
Dim a(), oDict As Object, i As Long, temp As String
On Error Resume Next

 a = Range("a1:f" & Range("A" & Rows.Count).End(xlUp).Row).Value
Set oDict = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a)
temp = UCase(Trim(a(i, 1)))
If Not oDict.Exists(temp) Then
oDict.Add temp, CStr(a(i, 3))
Else
oDict.Item(temp) = CStr(--oDict.Item(temp) + a(i, 3))
End If
Next
With Sheets("Анализ") 'ThisWorkbook.Worksheets(2)
.Range("C1").Resize(oDict.Count) = Application.Transpose(oDict.keys)
.Range("D1").Resize(oDict.Count) = Application.Transpose(oDict.items)
.Range("E1").Resize(oDict.Count) = Application.Transpose(oDict.items)
End With
End Sub