ExcelでFIFO関数を作成する方法

Question

価格計算のためにFIFO関数を作成する必要があります。

私は、次のレイアウトを持つテーブルがある：

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(... 

FIFO式は次のように動作します。

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

私はエクセルVBAでこれをどのように行うのですか？

Answer 1

ここで私が始めたのは、エラーチェックと日付マッチングはありませんが、動作します。

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

私はVBAによる「最新の為替レート」を見つけるのと同様の問題がありました。これは、古典的なループがループインデックス（Idx as Integer）と2つの終了基準を構築するより多くのだ、私はすべて渡って行く必要はありません...多分それはあなたを刺激することができ、

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 

私のコードですの下の行すべて状況。