如何在 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

如何在 Excel 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 查找“最新汇率”时遇到了类似的问题。这是我的代码，也许它可以启发您...

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）和两个退出条件的经典循环构造，因此我不需要遍历 < 所有情况下的所有行。