I need to create a fifo function for price calculation.
I have a table with the following layout:
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(...
the Fifo formula works like:
fifo_costprice(Q_sold_to_date as float, Quantity_purchased as range
, Purchase_Prices as range) a开发者_开发问答s float
How do I do this in Excel VBA?
Here's what I came up with to start, it doesn't do any error checking and date matching, but it works.
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
I had a similar problem finding the "most recent exchange rate" via VBA. This is my code, maybe it can inspire you ...
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
It's more a classical loop construct with a loop index (Idx as Integer
) and two exit criteria, so I don't need to go across all rows under all circumstances.
精彩评论