Kişi Bazlı Satış Raporu

[bosshakan]

Merhaba arkadaşlar, şöyle bir şey yapmak istiyorum;

A sütununda satır satır ürün isimleri yazıyor ve aynı olanlar var
B sütununda o ürünün kaç tane satıldığı yazıyor
C sütununda ürünün birim fiyatı yazıyor
D sütununda ürünü kimin sattığı yazıyor ve aynı olanlar var

E F G H sütunlarına,

Kişiye göre sıralayarak, kim hangi üründen kaç tane satmış ve toplam ne kadarlık satmışı yazdırmak istiyorum yani tablo şu şekildeyken:

Ürün 1 | 5 | 22,00 | Ahmet
------------------------------
Ürün 1 | 1 | 22,00 | Ahmet
------------------------------
Ürün 2 | 2 | 12,00 | Faruk
------------------------------
Ürün 1 | 2 | 22,00 | Mert
------------------------------
Ürün 3 | 1 | 28,00 | Murat
------------------------------
Ürün 3 | 1 | 28,00 | Ahmet


Şu şekile getirmek istiyorum:

Ürün 1 | 6 | 132,00 | Ahmet
------------------------------
Ürün 3 | 1 | 28,00 | Ahmet
------------------------------
Ürün 2 | 2 | 24,00 | Faruk
------------------------------
Ürün 1 | 2 | 44,00 | Mert
------------------------------
Ürün 3 | 1 | 28,00 | Murat

Çok vaktinizi almayacaksa yardımcı olabilir misiniz?

 

[Orion1]

Örnek dosya için link veriniz.

 

[bosshakan]

Düzenleme: Pardon anlayamadım ilk seferinde şuradan indirebilirsiniz örneği: http://goo.gl/T4pnru

 

[Orion1]

Dosyanız linktedir.

DOSYAYI İNDİR

Option Base 1
Sub benzersiz59()
Dim sonsat As Long, liste(), myarr(), z As Object, n As Long
Dim deg As String, i As Long
Range("F2:I" & Rows.Count).ClearContents
sonsat = Cells(Rows.Count, "A").End(xlUp).Row
liste = Range("A2:D" & sonsat).Value
ReDim myarr(1 To 4, 1 To sonsat)
Set z = CreateObject("Scripting.dictionary")
For i = 1 To UBound(liste)
    deg = liste(i, 1) & liste(i, 4)
    If Not z.exists(deg) Then
        n = n + 1
        z.Add deg, n
        myarr(1, n) = liste(i, 1)
        myarr(3, n) = liste(i, 3)
        myarr(4, n) = liste(i, 4)
    End If
    myarr(2, z.Item(deg)) = myarr(2, z.Item(deg)) + liste(i, 2)
Next i
Set z = Nothing
Erase liste()
ReDim Preserve myarr(1 To 4, 1 To n)
Application.ScreenUpdating = False
Range("F2").Resize(n, 4) = Application.Transpose(myarr)
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & "evrengizlen@hotmail.com"
End Sub

 

[bosshakan]

Hocam teşekkür ederim öncelikle, emeğinize sağlık.

Bu ürün bazlı sıralıyor, bunu kişi bazlı sıralamak için neyi değiştirmem gerekiyor ?

Düzenleme: pardon hocam ya filtre ile isme göre dizdirebilirim bunu verdikten sonra kafam gitti teşekkür ederim tekrar, vakit ayırdınız o kadar elinize sağlık.

 

[Orion1]

Hocam teşekkür ederim öncelikle, emeğinize sağlık.

Bu ürün bazlı sıralıyor, bunu kişi bazlı sıralamak için neyi değiştirmem gerekiyor ?

Düzenleme: pardon hocam ya filtre ile isme göre dizdirebilirim bunu verdikten sonra kafam gitti teşekkür ederim tekrar, vakit ayırdınız o kadar elinize sağlık.

Rica ederim.
İyi çalışmalar.