Excel de formül ile Fifo değeri getirme

adamar · 30 Kasım 2021

Merhaba Üstatlar,

Ekte eklediğim dosya da Sarı ile işaretli alana formülle İlk Giren İlk Çıkar değerinin gelmesi için yardımcı olur musunuz
Saygılarımla

Mahir64 · 30 Kasım 2021

Merhaba,

İşlem ile ilgili detay verebilir misiniz?
Konuya hakimsiniz olması gerekeni yazmışsınız ama bilmeyenler için işlem basamağı gerekli.

nunikmakarios · 30 Kasım 2021

Merhaba

muhasebe programları FİFO maliyet yöntemeni kullanılması için her stok kartının altında her farklı giriş için bir alt kart açar ve ilk kartın bakiyesi kalmadığında ikinci karta geçer. Burada bunu yapmak zor ama imkansız değil fakat pratik olacağını sanmam. her giriş için ayrı sütınlar kullanman gerek.

adamar · 1 Aralık 2021

nunikmakarios' Alıntı:
Merhaba

muhasebe programları FİFO maliyet yöntemeni kullanılması için her stok kartının altında her farklı giriş için bir alt kart açar ve ilk kartın bakiyesi kalmadığında ikinci karta geçer. Burada bunu yapmak zor ama imkansız değil fakat pratik olacağını sanmam. her giriş için ayrı sütınlar kullanman gerek.

İlginiz için teşekkür ederim,
Ürünlerin girişlerinde tarih bazlı fiyat değişiklikleri oluyor ve malz. girişleri ayrı bi sayfadan alıyoruz.
Burada esas olan aynı gün gelen malzeme fiyatında değişiklik olmamasından sağa doğru sütun açamyorum.

Gönderdiğim sayfa stoğa giren sadece 1 tane ürüne ait olan sayfa, üretimde maliyeti belirlemek için böyle bir örnek sizlere özetleyebildim
Bu şekli ile stok sayfasında o güne ait bir önceki stokdaki ürün bitene kadar önceki fiyatından değerleyecek şekilde yapabilir miyiz.

Yardımınız için şimdiden çok teşekkür ederim.

adamar · 1 Aralık 2021

Mahir64' Alıntı:
Merhaba,

İşlem ile ilgili detay verebilir misiniz?
Konuya hakimsiniz olması gerekeni yazmışsınız ama bilmeyenler için işlem basamağı gerekli.

İlginiz için teşekkür ederim,

Ürünlerin girişlerinde tarih bazlı fiyat değişiklikleri oluyor ve malz. girişleri ayrı bi sayfadan alıyoruz.
Burada esas olan aynı gün gelen malzeme fiyatında değişiklik olmuyor.

Gönderdiğim sayfa stoka giren sadece 1 tane ürüne ait olan sayfa, üretimde maliyeti belirlemek için böyle bir örnek sizlere özetleyebildim
Bu şekli ile stok sayfasında o güne ait bir önceki stokdaki ürün bitene kadar önceki fiyatından değerleyecek şekilde yapabilir miyiz.

Yardımınız için şimdiden çok teşekkür ederim.

adamar · 2 Aralık 2021

üstatlar bu konuda yardımcı olabilirmisiniz

nunikmakarios · 3 Aralık 2021

Formülle zor görünüyor

dost · 7 Aralık 2021

Merhaba,

Formülle istemişsiniz. Makro ile çözümü aşağıdadır.

Test edersiniz.

C++:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, sumIn As Double, sumOut As Double, sumVal As Double
Dim i As Long, ii As Long, j As Long
Dim dCont As Boolean

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

With Sheets("Sayfa1")
    .Range("H3", .Cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B3", .Cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then List(i, 7) = List(i, 4) / List(i, 1)
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

adamar · 14 Aralık 2021

dost' Alıntı:

Merhaba,

Formülle istemişsiniz. Makro ile çözümü aşağıdadır.

Test edersiniz.

C++:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, sumIn As Double, sumOut As Double, sumVal As Double
Dim i As Long, ii As Long, j As Long
Dim dCont As Boolean

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

With Sheets("Sayfa1")
    .Range("H3", .Cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B3", .Cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then List(i, 7) = List(i, 4) / List(i, 1)
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Merhabalar emeğinize sağlık,
test ettim "End With" satırıyla ilgili hata mesajı veriyor ve çalışmıyor.

dost · 15 Aralık 2021

Merhaba,

Bende bu kod doğru çalışıyor.

#8 nolu mesajımdaki kodda;

C#:

With Sheets("Sayfa1")

"Sayfa1" senin dosyandaki sayfa ismi ile aynı mı? Değilse sizin dosyanızdaki sayfa isminizi "Sayfa1" ile değiştiriniz.

Ayrıca ilk satırdaki kalan stok için kodda revize yaptım.

C#:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, sumIn As Double, sumOut As Double, sumVal As Double
Dim i As Long, ii As Long, j As Long
Dim dCont As Boolean

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

With Sheets("Sayfa1")  'Sayfa1 yerine kendi dosyanızdaki sayfa ismini kullanınırsınız.
    .Range("H3", .Cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B3", .Cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    If List(1, 1) = 0 And List(1, 2) = 0 Then List(1, 1) = List(1, 3): List(1, 4) = List(1, 6)
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then List(i, 7) = List(i, 4) / List(i, 1)
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

adamar · 15 Aralık 2021

dost' Alıntı:

Merhaba,

Bende bu kod doğru çalışıyor.

#8 nolu mesajımdaki kodda;

C#:

With Sheets("Sayfa1")

"Sayfa1" senin dosyandaki sayfa ismi ile aynı mı? Değilse sizin dosyanızdaki sayfa isminizi "Sayfa1" ile değiştiriniz.

Ayrıca ilk satırdaki kalan stok için kodda revize yaptım.

C#:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, sumIn As Double, sumOut As Double, sumVal As Double
Dim i As Long, ii As Long, j As Long
Dim dCont As Boolean

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

With Sheets("Sayfa1")  'Sayfa1 yerine kendi dosyanızdaki sayfa ismini kullanınırsınız.
    .Range("H3", .Cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B3", .Cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    If List(1, 1) = 0 And List(1, 2) = 0 Then List(1, 1) = List(1, 3): List(1, 4) = List(1, 6)
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then List(i, 7) = List(i, 4) / List(i, 1)
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Üstat; Elinize emeğinize sağlık.
makro yu kendi dosyama göre değişikliklerini yaptım.
Sağlıklı bi şekilde çalışıyor. (Not : aynı gün işletmenin çalışmadığı günler giren ve çıkan değer olmazsa o gün için hesaplamayı boş bırakıyor. bu durumu bir önceki gün rakamını alacak şekilde uygulamak mümkün mü.

dost · 15 Aralık 2021

Merhaba,

C++:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, TmpCost As Double, sumIn As Double, sumOut As Double, sumVal As Double
Dim i As Long, ii As Long, j As Long
Dim dCont As Boolean

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

With Sheets("Sayfa1")  'Sayfa1 yerine kendi dosyanızdaki sayfa ismini kullanınırsınız.
    .Range("H3", .Cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B3", .Cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    If List(1, 1) = 0 And List(1, 2) = 0 Then List(1, 1) = List(1, 3): List(1, 4) = List(1, 6)
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    TmpCost = 0
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            TmpCost = Cost:  sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then
                List(i, 7) = List(i, 4) / List(i, 1)
            Else
                If i > 1 Then List(i, 6) = sumVal:   List(i, 7) = TmpCost
            End If
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

adamar · 16 Aralık 2021

dost' Alıntı:

Merhaba,

C++:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, TmpCost As Double, sumIn As Double, sumOut As Double, sumVal As Double
Dim i As Long, ii As Long, j As Long
Dim dCont As Boolean

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

With Sheets("Sayfa1")  'Sayfa1 yerine kendi dosyanızdaki sayfa ismini kullanınırsınız.
    .Range("H3", .Cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B3", .Cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    If List(1, 1) = 0 And List(1, 2) = 0 Then List(1, 1) = List(1, 3): List(1, 4) = List(1, 6)
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    TmpCost = 0
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            TmpCost = Cost:  sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then
                List(i, 7) = List(i, 4) / List(i, 1)
            Else
                If i > 1 Then List(i, 6) = sumVal:   List(i, 7) = TmpCost
            End If
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

emeğinize sağlık teşekkür ederim

adamar · 6 Ocak 2022

dost' Alıntı:

Merhaba,

C++:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, TmpCost As Double, sumIn As Double, sumOut As Double, sumVal As Double
Dim i As Long, ii As Long, j As Long
Dim dCont As Boolean

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

With Sheets("Sayfa1")  'Sayfa1 yerine kendi dosyanızdaki sayfa ismini kullanınırsınız.
    .Range("H3", .Cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B3", .Cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    If List(1, 1) = 0 And List(1, 2) = 0 Then List(1, 1) = List(1, 3): List(1, 4) = List(1, 6)
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    TmpCost = 0
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            TmpCost = Cost:  sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then
                List(i, 7) = List(i, 4) / List(i, 1)
            Else
                If i > 1 Then List(i, 6) = sumVal:   List(i, 7) = TmpCost
            End If
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Merhaba,
Bu işlemi 963 ncü satırdan itibaren yapabilmek mümkün mü (Geçmiş dönemlere ait kayıtları değiştirmemek gerekli)
Not : Formülle yapabilsek çok güzel olacaktı.

dost · 9 Ocak 2022

adamar' Alıntı:
Merhaba,
Bu işlemi 963 ncü satırdan itibaren yapabilmek mümkün mü (Geçmiş dönemlere ait kayıtları değiştirmemek gerekli)
Not : Formülle yapabilsek çok güzel olacaktı.

Merhaba,

Çalıştığınız sayfanın B1 hücresine hesaplama yapılacak yılı girin. Hesaplamalar bu yılın ilk tarihinde itibaren yapılacaktır.

NOT: Fonksiyon ile yapmayı düşünüyorsanız Excel FIFO - No VBA linkindeki videoda gerekli açıklamalar mevcut. Kendi dosyanıza bunu uyarlayın.

C++:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, TmpCost As Double, sumIn As Double, sumOut As Double, sumVal, sDate As Double
Dim i As Long, ii As Long, j, sRow As Long
Dim dCont As Boolean


With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

sDate = DateSerial(Sheets("Sayfa1").Range("B1"), 1, 1)  'B1 hücresine hesaplama yapılacak yılı giriniz.
sDate = WorksheetFunction.Large(Sheets("Sayfa1").Range("A:A"), _
            WorksheetFunction.CountIf(Sheets("Sayfa1").Range("A:A"), ">=" & sDate))  'Girilen yılın ilk tarihini bulur.
           
sRow = WorksheetFunction.Match(sDate, ThisWorkbook.Sheets("Sayfa1").Range("A:A"), 0)  'Bulunanan tarihin ilk satırını bulur.

With Sheets("Sayfa1")  'Sayfa1 yerine kendi dosyanızdaki sayfa ismini kullanınırsınız.
    .Range("H" & sRow, .cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B" & sRow, .cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    If List(1, 1) = 0 And List(1, 2) = 0 Then List(1, 1) = List(1, 3): List(1, 4) = List(1, 6)
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    TmpCost = 0
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            TmpCost = Cost:  sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then
                List(i, 7) = List(i, 4) / List(i, 1)
            Else
                If i > 1 Then List(i, 6) = sumVal:   List(i, 7) = TmpCost
            End If
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

emsey · 1 Nisan 2023

dost' Alıntı:

Merhaba,

Çalıştığınız sayfanın B1 hücresine hesaplama yapılacak yılı girin. Hesaplamalar bu yılın ilk tarihinde itibaren yapılacaktır.

NOT: Fonksiyon ile yapmayı düşünüyorsanız Excel FIFO - No VBA linkindeki videoda gerekli açıklamalar mevcut. Kendi dosyanıza bunu uyarlayın.

C++:

Sub BirimFiyatHesaplaFIFO()
Dim List As Variant
Dim Cost As Double, TmpCost As Double, sumIn As Double, sumOut As Double, sumVal, sDate As Double
Dim i As Long, ii As Long, j, sRow As Long
Dim dCont As Boolean


With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
End With
dCont = True

sDate = DateSerial(Sheets("Sayfa1").Range("B1"), 1, 1)  'B1 hücresine hesaplama yapılacak yılı giriniz.
sDate = WorksheetFunction.Large(Sheets("Sayfa1").Range("A:A"), _
            WorksheetFunction.CountIf(Sheets("Sayfa1").Range("A:A"), ">=" & sDate))  'Girilen yılın ilk tarihini bulur.
          
sRow = WorksheetFunction.Match(sDate, ThisWorkbook.Sheets("Sayfa1").Range("A:A"), 0)  'Bulunanan tarihin ilk satırını bulur.

With Sheets("Sayfa1")  'Sayfa1 yerine kendi dosyanızdaki sayfa ismini kullanınırsınız.
    .Range("H" & sRow, .cells(Rows.Count, "H").End(xlUp)).ClearContents
    List = .Range("B" & sRow, .cells(Rows.Count, "E").End(xlUp)).Resize(, 7).Value
    j = 1
    If List(1, 1) = 0 And List(1, 2) = 0 Then List(1, 1) = List(1, 3): List(1, 4) = List(1, 6)
    For i = LBound(List, 1) To UBound(List, 1)
        If List(i, 2) > 0 Then
            sumOut = List(i, 2)
            For ii = j To i - 1
                If List(ii, 1) > 0 Then
                    sumIn = sumIn + List(ii, 1)
                    TmpCost = 0
                    If dCont Then PrcIn = List(ii, 4) / List(ii, 1):  dCont = False
                    If sumIn > sumOut Then
                        Exit For
                    Else
                        Cost = Cost + (PrcIn * List(ii, 1))
                        List(ii, 1) = Empty:  dCont = True
                    End If
                End If
            Next
            If sumIn - sumOut > 0 Then
                Cost = (Cost + (PrcIn * (List(ii, 1) - (sumIn - sumOut)))) / sumOut
                List(ii, 1) = sumIn - sumOut
                sumVal = sumVal - (Cost * sumOut)
                List(i, 6) = sumVal
            Else
                Cost = Cost / sumOut
            End If
            List(i, 7) = Cost
            List(i, 5) = sumOut * Cost
            TmpCost = Cost:  sumIn = 0: sumOut = 0: Cost = 0: j = ii
        Else
            List(i, 5) = 0
            If List(i, 1) > 0 Then
                List(i, 7) = List(i, 4) / List(i, 1)
            Else
                If i > 1 Then List(i, 6) = sumVal:   List(i, 7) = TmpCost
            End If
        End If
        If List(i, 1) > 0 Then sumVal = sumVal + List(i, 4): List(i, 6) = sumVal
    Next
    .Range("F3").Resize(UBound(List, 1)) = Application.Index(List, 0, 5)
    .Range("G3").Resize(UBound(List, 1)) = Application.Index(List, 0, 6)
    .Range("H3").Resize(UBound(List, 1)) = Application.Index(List, 0, 7)
    Erase List
End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Harika olmuş emeğine sağlık @dost . Bende kodları aldım istifade ettim sayende Allah razı olsun. Benim buna paralel birde stok kodlarına göre koşul eklemem gerekti yapabilir miyiz acaba? Yani toplamlara bakarken stok koduna göre örneğin, elma ise elmanın giriş ve çıkışlarına göre, armut ise armutun giriş ve çıkışlarına göre maliyeti hesaplamam gerekecek. Bu kodlarda Böyle bir şey mümkün olur mu

Excel de formül ile Fifo değeri getirme

adamar

Ekli dosyalar

Mahir64

Destek Ekibi

nunikmakarios

Ekli dosyalar

adamar

adamar

adamar

nunikmakarios

dost

adamar

dost

adamar

dost

adamar

adamar

dost

emsey