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
Hosted by uCoz