Sub aaa()
Dim Dc As Object, a&, dt$, t1$, t2$, arr()
a = 1: dt = [C7]: dt = Replace(dt, "А", "A")
Set Dc = CreateObject("Scripting.Dictionary")
Do While InStr(a, dt, "A")
  a = InStr(a, dt, "A"): a = a + 1: t1 = vbNullString: t2 = t1
  Do While Mid$(dt, a, 1) Like "#": t1 = t1 & Mid$(dt, a, 1): a = a + 1: Loop
  Do While Mid$(dt, a, 1) <> "," And Mid$(dt, a, 1) <> "+"
    t2 = t2 & Mid$(dt, a, 1): a = a + 1
  Loop
  If Len(t1) > 0 And Len(t2) > 0 Then
    If Not Dc.exists(t2) Then Dc.Add t2, CDbl(t1) Else Dc.Item(t2) = Dc.Item(t2) + CDbl(t1)
  End If
  If a > Len(dt) Then Exit Do
Loop
If Dc.Count > 0 Then
  arr = Dc.keys: t1 = vbNullString
  For a = 0 To UBound(arr)
    t1 = t1 & "A" & Dc.Item(arr(a)) & arr(a) & "+"
  Next
  t1 = Left$(t1, Len(t1) - 1)
End If
[C10] = t1
End Sub

Function SumA$(s$)
  Dim re, ms, dc, i&, ks
  Set re = CreateObject("VBScript.RegExp"): re.Global = True: re.Pattern = "(A|А)(\d+)([^+,]+)"
  Set ms = re.Execute(s):  Set dc = CreateObject("Scripting.Dictionary")
  For i = 0 To ms.Count - 1
    dc(ms(i).submatches(2)) = Val(dc(ms(i).submatches(2))) + Val(ms(i).submatches(1))
  Next
  ks = dc.keys
  For i = 0 To UBound(ks)
    SumA = SumA & "+" & "A" & dc(ks(i)) & ks(i)
  Next
  SumA = Right(SumA, Len(SumA) - 1)
End Function