Mükerrer olan kayıtları tek sefer yazıp karşısındaki miktarları toplaması

[udentr2002]

Merhaba arkadaşlar,
ekli dosyada a stünunda madde isimleri vardır. bunların karşısında q stünunda bu maddelerin miktarları vardır. Yapmak istediğim.

Bir buton yardımı ile bu mükerrer olan kayıtları bir defa yazıp ve onların karşısında yazan miktarları yani q stünundaki değerleride toplayıp karşısına yazmasını istiyorum.

Mesala örnektede göreceksiniz acarbose denen veriye ait bir den fazla giriş kayıtı vardır bunu tek defa yazıp karşısındaki acarbose ait olan q stünunda yazan verileri de toplayıp karşısına yazsın. Mümkünse bunu başka bir sayfada yapsın.

Bu konuda yardımcı olursanız gerçketen sevinirim.

 

[hamitcan]

Deneyin.

Sub Tablo()
c = 1
s = Sheets("Etken").[a65536].End(3).Row
Sheets("Sayfa1").Range("a2:a" & s).Clear

For i = 2 To s
If WorksheetFunction.CountIf(Sheets("Etken").Range("a2:a" & i), Sheets("Etken").Cells(i, "a")) = 1 Then
c = c + 1
Sheets("Sayfa1").Cells(c, 1) = Sheets("Etken").Cells(i, "a")
Sheets("Sayfa1").Cells(c, 2) = WorksheetFunction.SumIf(Sheets("Etken").Range("a2:a" & s), Sheets("Sayfa1").Cells(c, "a"), Sheets("Etken").Range("q2:q" & s))
End If
Next
MsgBox "Bitti."
End Sub

 

[udentr2002]

Çok teşekkürler hamit hocam ellerinize sağlık