Sub SumsDAll() Dim Cnt, Cur, t, i As Integer Dim St(100) As String Dim Sm(100) As Double Dim Fnd As Boolean Dim Strn, rng, rng1, rng2 As String For t = 1 To 100 St(t) = "": Sm(t) = 0 Next t Cnt = 0: Cur = 0: Fnd = False rng = ActiveWindow.RangeSelection.Address k = InStr(1, rng, ",") If k < 1 Then MsgBox ("Выделенный диапазон недопустим!") GoTo ext End If rng1 = Mid(rng, 1, k - 1) rng2 = Mid(rng, k + 1, Len(rng) - k) z = 0 For Each rn In Range(rng1).Cells z = z + 1 If Cnt > 0 Then Fnd = False For t = 1 To Cnt If UCase(St(t)) = UCase(rn) Then Cur = t: Fnd = True: GoTo ex Next t End If 'Cnt>0 ex: If Fnd = False Then Cnt = Cnt + 1 St(Cnt) = rn Cur = Cnt End If j = 0 For Each rn2 In Range(rng2).Cells j = j + 1 If j = z Then Sm(Cur) = Sm(Cur) + rn2: GoTo ex2 Next rn2 ex2: Next rn Strn = "" For t = 1 To Cnt Strn = Strn + Mid(St(t), 1, 3) + "=" + CStr(Sm(t)) If t < Cnt Then Strn = Strn + "; " Next t Application.StatusBar = Strn ext: End Sub