vba 如何在 Excel 中创建 fifo 函数
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/6762290/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
How do I create a fifo function in Excel
提问by Johan
I need to create a fifo function for price calculation.
我需要创建一个用于价格计算的 fifo 函数。
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 公式的工作原理如下：
fifo_costprice(Q_sold_to_date as float, Quantity_purchased as range
, Purchase_Prices as range) as float
How do I do this in Excel VBA?
如何在 Excel VBA 中执行此操作？
回答by Johan
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
回答by MikeD
I had a similar problem finding the "most recent exchange rate" via VBA. This is my code, maybe it can inspire you ...
我在通过 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
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 allrows under allcircumstances.
它更像是一个带有循环索引 ( Idx as Integer) 和两个退出条件的经典循环构造，因此我不需要在所有情况下都遍历所有行。
