• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

farklı ürün gruplarının toplamlarını alma

Katılım
16 Haziran 2005
Mesajlar
164
Merhaba stoğumdaki ürünlerin toplamını excele aldım fakat farklı ürünlerin toplamını farklı bir sayfaya aktarmak istiyorum
örnek bir dosya gönderdim bununla ilgili bir macro vardı ama bulamadım
yardımcı olabilecek arkadaşlara şimdiden teşekkürler
 

Ekli dosyalar

Pivot(Özet)Tablo ile kolaylıkla yapabilirsiniz.
 
Merhaba stoğumdaki ürünlerin toplamını excele aldım fakat farklı ürünlerin toplamını farklı bir sayfaya aktarmak istiyorum
örnek bir dosya gönderdim bununla ilgili bir macro vardı ama bulamadım
yardımcı olabilecek arkadaşlara şimdiden teşekkürler

Topla çarpım ile olabilirmi ?
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Yada, sayın süleyman242'nin çözümlü dosyasında,

Sayfa2' de, B2 ve C2'deki Topla.Çarpım formülü yerine ;

B2'ye ;=ETOPLA(Sayfa1!$A$2:$A$100;A2;Sayfa1!$E$2:$E$100)

C2'ye ;=ETOPLA(Sayfa1!$A$2:$A$100;A2;Sayfa1!$K$2:$K$100)

yazabilir siniz.Formüllerdeki 100 olan sayıyı da isteğe bağlı olarak artırabilir siniz...

Kolay gelsin.
 
A sütunundaki değerelere göre yapılmıştır.:cool:
Dosyanız ektedir.:cool:
Kod:
Option Base 1
Sub topla59()
Dim z As Object, liste(), myarr(), n As Long, sat As Long
Dim sh As Worksheet
Sheets("Sayfa1").Select
Sheets("Sayfa2").Range("A2:K" & Rows.Count).ClearContents
sat = Cells(Rows.Count, "A").End(xlUp).Row
liste = Range("A2:K" & sat).Value
ReDim myarr(1 To 11, 1 To UBound(liste))
Set z = CreateObject("scripting.Dictionary")
For i = 1 To UBound(liste)
    If Not z.exists(liste(i, 1)) Then
        n = n + 1
        z.Add (liste(i, 1)), n
        myarr(1, n) = liste(i, 1)
        myarr(3, n) = liste(i, 3)
        myarr(8, n) = liste(i, 8)
    End If
    myarr(5, z.Item(liste(i, 1))) = myarr(5, z.Item(liste(i, 1))) + liste(i, 5)
    myarr(11, z.Item(liste(i, 1))) = myarr(11, z.Item(liste(i, 1))) + liste(i, 11)
Next i
ReDim Preserve myarr(1 To 11, 1 To n)
Application.ScreenUpdating = False
Sheets("Sayfa2").Select
Range("A2").Resize(n, 11) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır." & vbLf & "evrengizlen@hotmail.com", _
        vbOKOnly + vbInformation, Application.UserName
End Sub
 

Ekli dosyalar

süper oldu herkese teşekkürler özellikle orion1 e teşekkürler
 
Geri
Üst