Sub SumsAll()

    Dim Cnt, Cur, t, i As Integer
    Dim St(100) As String
    Dim Sm(100) As Double
    Dim Fnd As Boolean
    Dim Strn As String
    
    For t = 1 To 100
        St(t) = "": Sm(t) = 0
    Next t
    Cnt = 0: Cur = 0: Fnd = False
    
    rng = ActiveWindow.RangeSelection.Address
    For Each rn In Range(rng).Cells
        If Len(rn) > 1 And Val(rn) = 0 Then
           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
        Else
           Sm(Cur) = Sm(Cur) + rn
        End If

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