• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

A

ATEMİ

Altın Üye
Katılım
9 Ocak 2006
Mesajlar
461
Excel Vers. ve Dili
Office 2021 Türkçe
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
 

Ekli dosyalar

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

​

 
Bir modüle
Kod: 
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

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

yazıp aşağı doğru çekiniz.
 
Ali' Alıntı:
Bir modüle
Kod: 
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

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

yazıp aşağı doğru çekiniz.
Genişletmek için tıkla ...
Ali bey çok teşekkür ederim çok güzel bir çalışma olmuş
Korhan hocanın fonksiyonu çok işime yarayacak gibi duruyor
sizin çalışmanızı da değerlendireceğim sağolun
 
Kümülatif Alış ve Kümülatif Satış ayrı sütunlarda olmalı...

Kendi kurgunuzu buna göre düzeltmenizi tavsiye ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst