Как создать функцию fifo в Excel - PullRequest
Новая
       18

Как создать функцию fifo в Excel

1 голос
/ 20 июля 2011

Мне нужно создать функцию 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?

Ответы [ 2 ]

2 голосов
/ 20 июля 2011

Вот то, что я придумал для начала, он не выполняет никакой проверки ошибок и сопоставления дат, но работает. 

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 голос
/ 21 июля 2011

У меня была похожая проблема с поиском «самого последнего обменного курса» через 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) и двумя критериями выхода, поэтому мне не нужно идтив всех строках при всех обстоятельствах.

...