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