Eğer toplama yapamıyorum.

[pitsss]

iyi akşamlar arkadaşlar;


grup1 ürün1 1
grup1 ürün1 5
grup1 ürün2 6
grup1 ürün3 4
grup1 ürün1 2
grup1 ürün2 8
grup1 ürün3 9
grup1 ürün2 4
grup1 ürün3 5
grup1 ürün2 1
grup2 ürün2 5
grup2 ürün1 8
grup2 ürün1 7
grup2 ürün2 4
grup2 ürün3 1
grup2 ürün3 1
grup2 ürün1 4
grup3 ürün1 6
grup3 ürün1 5
grup3 ürün2 6
grup3 ürün3 1
grup3 ürün3 2
grup3 ürün2 4


yukarıdaki gruplar, ürünler ve rakamlar var
yapmak istediğim grup1 deki ürün1 den kaç kez tekrarlanmışsa toplasın ve başka bir sayfaya grup1 ürün1 8 yazsın. aynı aşağıdaki olduğu gibi gruplardaki ürünlerin mükerrerleri toplayacak. bunu makro ile nasıl yapabilirim acaba?

grup1 ürün1 8
grup1 ürün2 19
grup1 ürün3 18
grup2 ürün1 19
grup2 ürün2 9
grup2 ürün3 2
grup3 ürün1 11
grup3 ürün2 10
grup3 ürün3 3

 

[baydeniro]

Merhaba. Bu tarz sorularda örnek dosya eklemeniz daha iyi olur

 

[İhsan Tank]

merhaba
gruplar A sütununda ürünler B sütununda rakamlar C sütununda olduğunu varsayarsak
G1 hücresine Grup
H1 hücresine Ürün yazınız ve bu formülü yazınız

=TOPLA.ÇARPIM(($A$1:$A$1000=$G1)*($B$1:$B$1000=$H1)*($C$1:$C$1000))

formülde 1000 satır baz alınmıştır.

 

[pitsss]

dosya olarak soruyu ekledim. Sayın İhsan Tank formül ile vermiş olduğunuz cevap için çok teşekkür ederim ancak ürünler ve gruplar çok farklılık göstereceğinden dolayı. bunu makro ile yapabilme şansım var mıdır acaba? eğer olmazsa sizin yapmış olduğunuz formülü kendime uyarlamaya çalışacağım.

 

[İhsan Tank]

Sayfa2'yi tamamen kod ile mi istiyorsunuz

 

[pitsss]

evet kod ile istiyorum ama, kafamı toparlayıp bir türlü birşeyler ortaya çıkaramadım :S. normalde yapmaya çalışırdım makro ama, bu sefer hiç kalem oynatamadım :S

 

[İhsan Tank]

evet kod ile istiyorum ama, kafamı toparlayıp bir türlü birşeyler ortaya çıkaramadım :S. normalde yapmaya çalışırdım makro ama, bu sefer hiç kalem oynatamadım :S

merhaba
boş bir module kopyalarak dener misiniz

Option Explicit
Sub tek_liste()
Dim ts, kaplan, bordo, mavi, hamsi, trabzonspor
trabzonspor = MsgBox("Topluyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
bordo = 1
Sheets("Sayfa2").Range("A:C").ClearContents
For ts = 1 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
Sheets("Sayfa2").Cells(ts, "G") = Sheets("Sayfa1").Cells(ts, "A") & _
Sheets("Sayfa1").Cells(ts, "B")
Next
For kaplan = 1 To Sheets("Sayfa2").Cells(65536, "G").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa2").Range("G1:G" & kaplan), _
Sheets("Sayfa2").Cells(kaplan, "G")) = 1 Then
Sheets("Sayfa2").Cells(bordo, "A") = Mid(Sheets("Sayfa2").Cells(kaplan, "G"), _
1, 5)
Sheets("Sayfa2").Cells(bordo, "B") = Mid(Sheets("Sayfa2").Cells(kaplan, "G"), _
6, 5)
bordo = bordo + 1
End If
Next
Sheets("Sayfa2").Range("G:G").ClearContents
hamsi = Sheets("Sayfa1").Range("A65536").End(xlUp).Row
For kaplan = 1 To Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
Sheets("Sayfa2").Cells(kaplan, "C") = Evaluate("=SumProduct((Sayfa1!A1:A" & hamsi & "=Sayfa2!A" & kaplan & ")*(Sayfa1!B1:B" & hamsi & "=Sayfa2!B" & kaplan & ")*(Sayfa1!C1:C" & hamsi & "))")
Next
MsgBox "Topladım", vbInformation, "Bitiş"
End Sub

 

[pitsss]

İhsan Bey, cevabınız ve uğraşınız için çok teşekkür ederim. denedim ve tam istediğim gibi çalışıyor.
Futbol ile pek aram olmasada trabzona bi sempatim vardı, şimdi daha da arttı
ben biraz kodlarınızı inceleyeyim bakalım anlayabilecek miyim
teşekkürler. Allah razı olsun.

 

[İhsan Tank]

İhsan Bey, cevabınız ve uğraşınız için çok teşekkür ederim. denedim ve tam istediğim gibi çalışıyor.
Futbol ile pek aram olmasada trabzona bi sempatim vardı, şimdi daha da arttı
ben biraz kodlarınızı inceleyeyim bakalım anlayabilecek miyim
teşekkürler. Allah razı olsun.

rica ederim
Trabzonspor aşığı olarak kodlarıma özellikle bu şekilde yön veriyorum
:yazici: