Comment créer une fonction fifo dans Excel

Question

J'ai besoin de créer une fonction fifo pour le calcul du prix.

J'ai une table avec la disposition suivante:

Purchase_date Quantity Purchase_Price 
---------------------------------------- 
2011-01-01  1000  10 
2011-01-02  2000  11 
...... 

Sale_date  Quantity Costprice 
---------------------------------------- 
2011-02-01  50  =fifo_costprice(... 

la formule Fifo fonctionne comme:

fifo_costprice(Q_sold_to_date as float, Quantity_purchased as range 
       , Purchase_Prices as range) as float 

Comment puis-je faire dans Excel VBA?

Answer 1

Voici ce que je suis venu pour commencer, il ne fait aucune vérification d'erreur et date correspondant, mais cela fonctionne.

Public Function fifo(SoldToDate As Double, Purchase_Q As Range, _ 
        Purchase_price As Range) As Double 
Dim RowOffset As Integer 
Dim CumPurchase As Double 
Dim Quantity As Range 
Dim CurrentPrice As Range 

    CumPurchase = 0 
    RowOffset = -1 
    For Each Quantity In Purchase_Q 
    CumPurchase = CumPurchase + Quantity.Value 
    RowOffset = RowOffset + 1 
    If CumPurchase > SoldToDate Then Exit For 
    Next 
    'if sold > total_purchase, use the last known price. 
    Set CurrentPrice = Purchase_price.Cells(1, 1).offset(RowOffset, 0) 
    fifo = CurrentPrice.Value 
End Function 

Answer 2

J'ai eu un problème similaire à trouver le "taux de change le plus récent" via VBA. Ceci est mon code, peut-être qu'il peut vous inspirer ...

Function GetXRate(CurCode As Variant, Optional CurDate As Variant) As Variant 
Dim Rates As Range, chkDate As Date 
Dim Idx As Integer 

    GetXRate = CVErr(xlErrNA)         ' set to N/A error upfront 
    If VarType(CurCode) <> vbString Then Exit Function   ' if we didn't get a string, we terminate 
    If IsMissing(CurDate) Then CurDate = Now()     ' if date arg not provided, we take today 
    If VarType(CurDate) <> vbDate Then Exit Function   ' if date arg provided but not a date format, we terminate 

    Set Rates = Range("Currency")        ' XRate table top-left is a named range 
    Idx = 2              ' 1st row is header row 
                   ' columns: 1=CurCode, 2=Date, 3=XRate 

    Do While Rates(Idx, 1) <> "" 
     If Rates(Idx, 1) = CurCode Then 
      If Rates(Idx, 2) = "" Then 
       GetXRate = Rates(Idx, 3)      ' rate without date is taken at once 
       Exit Do 
      ElseIf Rates(Idx, 2) > chkDate And Rates(Idx, 2) <= CurDate Then 
       GetXRate = Rates(Idx, 3)      ' get rate but keep searching for more recent rates 
       chkDate = Rates(Idx, 2)       ' remember validity date 
      End If 
     End If 
     Idx = Idx + 1 
    Loop 
End Function 

Il est plus une boucle classique construire avec un indice de boucle (Idx as Integer) et deux critères de sortie, donc je ne pas besoin d'aller dans tous lignes sous tous les circonstances.