• DİKKAT

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

Excel de formül ile Fifo değeri getirme

A

adamar

Altın Üye
Katılım
23 Mayıs 2007
Mesajlar
94
Excel Vers. ve Dili
office 365
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
 

Ekli dosyalar

Merhaba,

İşlem ile ilgili detay verebilir misiniz?
Konuya hakimsiniz olması gerekeni yazmışsınız ama bilmeyenler için işlem basamağı gerekli.
 
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.
 

Ekli dosyalar

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.
Genişletmek için tıkla ...

İ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.
 
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.
Genişletmek için tıkla ...


İ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.
 
üstatlar bu konuda yardımcı olabilirmisiniz
 
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
 
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
Genişletmek için tıkla ...
Merhabalar emeğinize sağlık,
test ettim "End With" satırıyla ilgili hata mesajı veriyor ve çalışmıyor.
 
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
 
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
Genişletmek için tıkla ...
Ü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ü.
 
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
 
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
Genişletmek için tıkla ...
emeğinize sağlık teşekkür ederim
 
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
Genişletmek için tıkla ...

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ı.
 
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ı.
Genişletmek için tıkla ...

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
 
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
Genişletmek için tıkla ...
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
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst