koşula göre toplama yaptırma

[XExcel]

örnek dosyayı ekledim , yarımlarınız için sağolun

Saygılar

 

[İhsan Tank]

örnek dosyayı ekledim , yarımlarınız için sağolun

Saygılar

merhaba
eki inceleyiniz
formüller 40. satıra kadar yayılmıştır çoğaltınız

 

[Orion1]

Dosyanız ektedir.

Option Base 1
Sub topla_59()
Dim list(), sat As Long, myarr(), tpl As Long, a As Long
Dim i As Long, k As Byte
Sheets("Sayfa1").Select
Range("L2:U65536").ClearContents
sat = Cells(65536, "A").End(xlUp).Row
list = Range("A1:J" & sat).Value
ReDim myarr(1 To 10, 1 To UBound(list, 1))
For i = 1 To UBound(list, 1)
    tpl = list(i, 1) + 1
    myarr(1, i) = tpl
    For k = 2 To 10
        tpl = tpl + list(i, k)
        myarr(k, i) = tpl
    Next
Next
Application.ScreenUpdating = False
Range("L1").Resize(UBound(list, 1), 10) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "İşlem tamamdır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[XExcel]

Emeğinize ve ilginize teşekür ederim.

 

[Orion1]

Emeğinize ve ilginize teşekür ederim.

Rica ederim.
İyi çalışmalar.

 

[furens]

hocam siz bir harikasınız

 

[Orion1]

hocam siz bir harikasınız

Rica ederim.
O sizin harikalığınız.