Satışın maliyetini FİFO yöntemine göre formül kullanarak bulma

[ATEMİ]

Merhaba Arkadaşlar
Ekte paylaştığım dosyada satışların maliyetini alışlara bakarak FİFO yöntemine göre formül kullanarak bulmasını istiyorum formül konusunda yardımcı olursanız sevinirim

 

[programer]

Merhahba,
Aşağıdaki linkte sayın Zeki Gürsoy'un hazırladığı bir çalışma var. Kendinize göre uyarlamaya çalışabilirsiniz.

FIFO & LIFO Maliyet Hesaplama

İyi Çalışmalar.

 

[ATEMİ]

sayın programer dosyayı açamadım ama benim aradığım ilgili hücre için fonksiyon formülü yine de çok teşekkür ederim

​

 

[Korhan Ayhan]

İşinize yarayabilir...

 

[Ali]

Bir modüle

Option Explicit

Function FIFO_MALIYET(AlisMiktar As Range, AlisBirimFiyat As Range, SatisMiktar As Range) As Variant
    Dim arrAQty As Variant, arrAPrice As Variant, arrSQty As Variant
    Dim i As Long
    Dim toplamSatis As Double, mevcutSatis As Double
    Dim hedefBas As Double, hedefBit As Double
    Dim kumeBas As Double, kumeBit As Double
    Dim ortakMiktar As Double
    Dim maliyet As Double
    
    If AlisMiktar.Rows.Count <> AlisBirimFiyat.Rows.Count Then
        FIFO_MALIYET = CVErr(xlErrRef)
        Exit Function
    End If
    
    If SatisMiktar.Rows.Count = 0 Then
        FIFO_MALIYET = ""
        Exit Function
    End If
    
    arrAQty = AlisMiktar.Value2
    arrAPrice = AlisBirimFiyat.Value2
    arrSQty = SatisMiktar.Value2
    
    ' Toplam satış ve mevcut satırdaki satış
    For i = 1 To UBound(arrSQty, 1)
        If IsNumeric(arrSQty(i, 1)) And arrSQty(i, 1) <> "" Then
            toplamSatis = toplamSatis + CDbl(arrSQty(i, 1))
        End If
    Next i
    
    If IsNumeric(arrSQty(UBound(arrSQty, 1), 1)) Then
        mevcutSatis = CDbl(arrSQty(UBound(arrSQty, 1), 1))
    Else
        mevcutSatis = 0
    End If
    
    If mevcutSatis <= 0 Then
        FIFO_MALIYET = ""
        Exit Function
    End If
    
    ' Bu satışın FIFO’da kapladığı aralık
    hedefBas = toplamSatis - mevcutSatis
    hedefBit = toplamSatis
    
    ' Alış partileri üzerinde ilerle
    kumeBit = 0
    maliyet = 0
    
    For i = 1 To UBound(arrAQty, 1)
        If IsNumeric(arrAQty(i, 1)) And arrAQty(i, 1) > 0 Then
            kumeBas = kumeBit
            kumeBit = kumeBit + CDbl(arrAQty(i, 1))
            
            ortakMiktar = WorksheetFunction.Max(0, _
                          WorksheetFunction.Min(kumeBit, hedefBit) - _
                          WorksheetFunction.Max(kumeBas, hedefBas))
            
            If ortakMiktar > 0 Then
                maliyet = maliyet + ortakMiktar * CDbl(arrAPrice(i, 1))
            End If
        End If
    Next i
    
    FIFO_MALIYET = maliyet
End Function

Function FIFO_BIRIM_MALIYET(AlisMiktar As Range, AlisBirimFiyat As Range, SatisMiktar As Range) As Variant
    Dim toplamMaliyet As Variant
    Dim mevcutSatis As Double
    
    If IsNumeric(SatisMiktar.Cells(SatisMiktar.Rows.Count, 1).Value) Then
        mevcutSatis = CDbl(SatisMiktar.Cells(SatisMiktar.Rows.Count, 1).Value)
    Else
        mevcutSatis = 0
    End If
    
    If mevcutSatis <= 0 Then
        FIFO_BIRIM_MALIYET = ""
        Exit Function
    End If
    
    toplamMaliyet = FIFO_MALIYET(AlisMiktar, AlisBirimFiyat, SatisMiktar)
    
    If IsError(toplamMaliyet) Then
        FIFO_BIRIM_MALIYET = toplamMaliyet
    Else
        FIFO_BIRIM_MALIYET = toplamMaliyet / mevcutSatis
    End If
End Function

kodlarını ekleyin.

N9 hücresine de

=EĞER(K9=0;"";FIFO_MALIYET($G$9:G9;$H$9:H9;$K$9:K9))

yazıp aşağı doğru çekiniz.