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

Katılım
26 Eylül 2021
Mesajlar
52
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
12.10.2022
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.
 

Ekli dosyalar

kulomer46

Altın Üye
Katılım
23 Mart 2007
Mesajlar
1,513
Excel Vers. ve Dili
Microsoft Office LTSC Professional Plus 2021 - Türkçe
Altın Üyelik Bitiş Tarihi
08-06-2027
Katılım
26 Eylül 2021
Mesajlar
52
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
12.10.2022
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

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
Merhaba

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

veyselemre

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,646
Excel Vers. ve Dili
Pro Plus 2021
Kod:
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
 
Katılım
26 Eylül 2021
Mesajlar
52
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
12.10.2022
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...
 
Katılım
26 Eylül 2021
Mesajlar
52
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
12.10.2022
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

Özel Üye
Katılım
9 Mart 2005
Mesajlar
3,646
Excel Vers. ve Dili
Pro Plus 2021
Bende herhangi bir sorun yok, makroyu biraz kısalttım. Hata verirse örnek ekleyin.
Kod:
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
 
Katılım
26 Eylül 2021
Mesajlar
52
Excel Vers. ve Dili
2016 Türkçe
Altın Üyelik Bitiş Tarihi
12.10.2022
Sayın Veyselemre,

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