Need to get the gain (or loss) per sell transaction by using the existing code to remove earliest bought stocks from the queue, but add additional lines to work out:
gain = sale price * sale quantity - ∑ buy price * buy quantity
where the summation is over the different 'buy' transactions that satisfy the sale quantity, in chronological order.
I have now added the additional calculations suggested by OP and added some basic error handling (e.g. that the user doesn't try to sell more stocks than are available, making the queue become empty).
The UDF only accepts single-column arguments either as ranges or arrays.
UDF
Need a BuySell class as before:
Public rate As Double
Public qty As Double
Option Explicit
Function avgRate(qtyRange As Variant, rateRange As Variant, Optional calcNumber As Integer = 1)
' Create the queue
Dim queue As Object
Set queue = CreateObject("System.Collections.Queue")
' Declare some variables
Dim bs As Object
Dim qty As Double
Dim rate As Double
Dim qtySold As Double
Dim qtyBought As Double
Dim qtyRemaining As Double
Dim rateBought As Double
Dim i As Long
Dim sumRate As Double, totalQty As Double
Dim avRate As Double
Dim saleValue As Double
Dim purchaseValue As Double
Dim gainForThisSale As Double
Dim totalGain As Double
Dim totalCost As Double
Dim totalProfit As Double
Dim overallCost As Double
Dim tempQty() As Variant, workQty() As Variant, tempRate() As Variant, workRate() As Variant
Dim nRows As Long
Dim argType As Integer
'Copy from range or array - assuming single column or single element in both cases.
If TypeOf qtyRange Is Range Then
If IsArray(qtyRange) Then
' column range
argType = 1
Else
' Single element range
argType = 2
End If
Else
If UBound(qtyRange, 1) > 1 Then
' Column array
argType = 3
Else
' Single element array
argType = 4
End If
End If
Debug.Print ("Argtype=" & argType)
Select Case argType
Case 1
tempQty = qtyRange.Value
tempRate = rateRange.Value
Case 2
nRows = 1
ReDim workQty(1 To nRows)
ReDim workRate(1 To nRows)
workQty(1) = qtyRange.Value
workRate(1) = rateRange.Value
Case 3
tempQty = qtyRange
tempRate = rateRange
Case 4
nRows = 1
ReDim workQty(1 To nRows)
ReDim workRate(1 To nRows)
workQty(1) = qtyRange(1)
workRate(1) = rateRange(1)
End Select
If argType = 1 Or argType = 3 Then
nRows = UBound(tempQty, 1)
ReDim workQty(1 To nRows)
ReDim workRate(1 To nRows)
For i = 1 To nRows
workQty(i) = tempQty(i, 1)
workRate(i) = tempRate(i, 1)
Next i
End If
' Loop over rows
totalProfit = 0
overallCost = 0
For i = 1 To nRows
qty = workQty(i)
' Do nothing if qty is zero
If qty = 0 Then GoTo Continue:
rate = workRate(i)
overallCost = overallCost + rate * qty
If qty > 0 Then
'Buy
Set bs = New BuySell
bs.rate = rate
bs.qty = qty
queue.Enqueue bs
Else
'Sell
qtyRemaining = -qty
'Code for realized Gain
purchaseValue = 0
saleValue = rate * qtyRemaining
totalProfit = totalProfit + saleValue
'Work through the 'buy' transactions in the queue starting at the oldest.
While qtyRemaining > 0
If queue.Count = 0 Then
avgRate = CVErr(xlErrNum)
Exit Function
End If
If qtyRemaining < queue.peek().qty Then
'More than enough stocks in this 'buy' to cover the sale so just work out what's left
queue.peek().qty = queue.peek().qty - qtyRemaining
'Code for realized gain
purchaseValue = purchaseValue + qtyRemaining * queue.peek().rate
qtyRemaining = 0
ElseIf qtyRemaining = queue.peek().qty Then
'Exactly enough stocks in this 'buy' to cover the sale so remove from queue
Set bs = queue.dequeue()
qtyRemaining = 0
'Code for realized gain
purchaseValue = purchaseValue + bs.qty * bs.rate
Else
'Not enough stocks in this 'buy' to cover the sale so remove from queue and reduce amount of sale remaining
Set bs = queue.dequeue()
qtyRemaining = qtyRemaining - bs.qty
'Code for realized gain
purchaseValue = purchaseValue + bs.qty * bs.rate
End If
Wend
'Code for realized gain
gainForThisSale = saleValue - purchaseValue
totalGain = totalGain + gainForThisSale
End If
Continue:
Next i
'Calculate average rate
If queue.Count = 0 Then
avRate = 0
Else
totalCost = 0
totalQty = 0
For Each bs In queue
totalCost = totalCost + bs.qty * bs.rate
totalQty = totalQty + bs.qty
Next
avRate = totalCost / totalQty
End If
Select Case calcNumber
Case 1
'Average rate
avgRate = avRate
Case 2
'Realized gain
avgRate = totalGain
Case 3
'Invested
avgRate = totalCost
Case 4
'Bal qty
avgRate = totalQty
Case 5
'Net worth (total quantity times most recent rate)
avgRate = totalQty * rate
Case 6
'Total profit (total sale amounts)
avgRate = totalProfit
Case 7
'Unrealized gain
avgRate = totalProfit - totalGain
Case 8
'Overall cost
avgRate = overallCost
Case Else
avgRate = CVErr(xlErrNum)
End Select
End Function
I have added a new version which tests for the first argument being an array or a range (and assumes the second argument is of the same type). OP has asked me to check for the case where it is a single element array or single-cell range as well. The main point of allowing arrays etc. is that you can have a function call like:
=avgRate(FILTER($C2:$C10,C2:C10=10),FILTER($A2:$A10,C2:C10=10),8)
or
=avgrate($C$2,$A$2,8)
to select (in this case) just the first row. This makes the UDF more versatile in situations where you may have stocks from more than one company and want to filter on the company.
与恶龙缠斗过久,自身亦成为恶龙；凝视深渊过久,深渊将回以凝视…
