Soru Pivot yardımıyla ağırlıklı ortalama hesabı

[sezgin06]

Merhabalar,

Elimizde farklı zaman, miktar ve fiyattan aldığımız A ürünü var Pivot tablo ile bu ürünün alış fiyatlarının ağırlıklı ortalaması formül ile hesaplanıyor.
Daha sonra herhangi bir fiyattan hepsini satıyoruz. Yani elimizde A ürünü kalmıyor. Aynı üründen bir miktar daha alıyoruz, Bu durumda alınan fiyatla tablodaki ağırlıklı ortalama fiyatı aynı olması gerekirken formül önceki alışları da hesaba katıyor. Tabi bu işlem diğer ürünler için de geçerli. Bunu nasıl düzeltebiliriz?
Veya örnekteki şablona göre vba yardımıyla pivot tablo olmadan bu işlem yapılabilir mi? Yardımlarınız için şimdiden teşekkürler.

 

[kulomer46]

Merhaba

Yukardaki talebinizle bağlantılı aşağıdaki dosya işinizi görebilir.

https://excel.web.tr/threads/kademeli-alim-satimlarda-ortalama-birim-fiyat-hesaplama.194332/

Selamlar...

 

[sezgin06]

Selamlar Ömer Bey

Eklediğiniz dosyayı daha önce inceledim, sorumun makro çözümü ve tek ürün olarak bu, ancak bendeki dosyada farklı ürünler aynı şablonda.
Sorun, makronun bu dosyaya uyarlanabilmesi,eğer vakit ayırıp ilgilenebilirseniz sevinirim.

İlginize teşekkür ederim...

 

[uzmanamele]

Merhaba

Tabloda değişiklik yaptıktan sonra Pivot Tabloyu yenile ( Refresh ) ederseniz sorun çözülür.

 

[veyselemre]

Sub test()
    Dim i&, w, y, krt, itms, kalanMaliyet As Double

    With CreateObject("Scripting.Dictionary")
        For i = 2 To Cells(Rows.Count, 2).End(3).Row
            krt = Cells(i, 3).Value
            If Not .exists(krt) Then
                ReDim w(1 To 1, 1 To 5)
                w(1, 2) = 0
                w(1, 3) = 0
                w(1, 4) = 0
                w(1, 5) = 0
                w(1, 1) = krt
                If Cells(i, 2).Value = "Alış" Then
                    w(1, 2) = Cells(i, 5).Value)
                    w(1, 5) = Cells(i, 4).Value)
                    Else
                    w(1, 3) = Cells(i, 5).Value
                End If
                w(1, 4) = w(1, 2) - w(1, 3)
                .Item(krt) = w
                Else
                y = .Item(krt)

                kalanMaliyet = y(1, 4) * y(1, 5)

                If Cells(i, 2).Value = "Alış" Then
                    y(1, 2) = y(1, 2) + Cells(i, 5).Value
                    y(1, 4) = y(1, 2) - y(1,3)
                    y(1, 5) = (kalanMaliyet + Val(Cells(i, 6).Value)) / y(1, 4)
                    Else
                    y(1, 3) = y(1, 3) + Val(Cells(i, 5).Value)
                    y(1, 4) = y(1, 2) - y(1,3)
                End If
                .Item(krt) = y
            End If

            Next
            itms = .items
            For i = 0 To UBound(itms)
                Cells(i + 15, "P").Resize(, 5).Value = itms(i)
            Next i
        End With
End Sub

 

[sezgin06]

Sayın Veyselemre, sorumun tam da cevabı bu makroydu,elinize emeğinize sağlık çok teşekkür ederim.

Bu arada soruyu tam manasıyla ifade etmemde yardımı olan Ömer bey'e de teşekkür ederim.

Saygılar selamlar...

 

[sezgin06]

Sayın Veyselemre selamlar;

Miktar veya Fiyat sütunlarına küsürlü rakam girildiğinde Ortalama Maliyet sonucunun yanlış çıktığını fark ettim, rica etsem bakabilir misiniz?

 

[veyselemre]

Bende herhangi bir sorun yok, makroyu biraz kısalttım. Hata verirse örnek ekleyin.

Sub test()
    Dim i&, y, krt, itms, kalanMaliyet As Double
    Dim w(1 To 1, 1 To 5)
    w(1, 2) = 0:      w(1, 3) = 0:      w(1, 4) = 0:     w(1, 5) = 0
    With CreateObject("Scripting.Dictionary")
        For i = 2 To Cells(Rows.Count, 2).End(3).Row

            krt = Cells(i, 3).Value
            If Not .exists(krt) Then
                w(1, 1) = krt
                .Item(krt) = w
            End If
            y = .Item(krt)
            kalanMaliyet = y(1, 4) * y(1, 5)
            If Cells(i, 2).Value = "Alış" Then
                y(1, 2) = y(1, 2) + Cells(i, 5).Value
                y(1, 4) = y(1, 2) - y(1, 3)
                y(1, 5) = (kalanMaliyet + Cells(i, 6).Value) / y(1, 4)
                Else
                y(1, 3) = y(1, 3) + Cells(i, 5).Value
                y(1, 4) = y(1, 2) - y(1, 3)
            End If
            .Item(krt) = y
            Next
            itms = .items
            For i = 0 To UBound(itms)
                Cells(i + 15, "P").Resize(, 5).Value = itms(i)
            Next i
        End With
End Sub

 

[sezgin06]

Sayın Veyselemre,

Teşekkür ederim hatasız,iyi akşamlar diliyorum...