2011-07-20 22 views
1

我需要为价格计算创建一个fifo函数。如何在Excel中创建一个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_costprice(Q_sold_to_date as float, Quantity_purchased as range 
       , Purchase_Prices as range) as float 

如何在Excel VBA中做到这一点?

回答

2

这是我想出发,它不做任何错误检查和日期匹配,但它的工作原理。

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 
1

我有一个类似的问题,通过VBA找到“最近的汇率”。这是我的代码,也许能激发你...

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 

它更经典的循环与循环指数(Idx as Integer)和两个出口标准建设,所以我并不需要跨所有去根据全部的情况。