基于FIFO的多股票买卖盈亏计算VBA代码问题排查

问题背景 #

开发面向小额交易者的股票盈亏计算VBA工具，基于**FIFO（先进先出）**规则计算三类盈亏：

• J列：pre_qtr profit（季度前已实现利润）
• K列：qtr_profit（本季度已实现利润）
• L列：Unrealized profit（未实现利润）

季度周期暂为宏内常量，后续将改为输入式。核心规则：卖出优先抵扣最早买入仓位，卖出数量不超过总买入量；未实现利润公式为 剩余数量×市价 - 剩余持仓总成本。

当前代码存在三类错误：

• 仅买入无卖出的股票计算错误
• 多笔卖出的股票计算错误
• 未实现盈亏计算错误

交易数据结构 #

表格共6列，示例数据如下：

错误原因分析 #

1. 仅买入无卖出场景：原代码误用单笔买入价lastBoughtPrice计算剩余持仓成本，未采用累计持仓总成本
2. 多笔卖出场景：原代码用平均成本抵扣，未严格遵循FIFO逐笔抵扣规则，且totalSold变量未初始化导致逻辑混乱
3. 未实现盈亏计算：原代码公式错误，未正确计算剩余持仓总成本与市价的差值

修复后的VBA代码 #

Sub CalculateFIFOProfit_Fixed()
    Const QTR_START_DATE As Date = #10/1/2023#
    Const QTR_END_DATE As Date = #12/31/2023#
    
    Dim ws As Worksheet
    Set ws = ActiveSheet ' 可改为指定工作表，如ThisWorkbook.Worksheets("交易数据")
    
    Dim currentRow As Long, lastRow As Long, lrow As Long
    Dim currentScrip As String
    Dim preQtrProfit As Double, thisQtrProfit As Double, unrealizedProfit As Double
    Dim marketPrice As Double
    
    ' 用集合存储每笔买入的仓位（日期、数量、单价），实现严格FIFO
    Dim buyPositions As Collection
    Set buyPositions = New Collection
    
    currentRow = 2
    lrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    currentScrip = ws.Cells(currentRow, 1).Value
    
    Do While currentRow <= lrow
        ' 切换股票时，输出上一只股票的结果并重置变量
        If ws.Cells(currentRow, 1).Value <> currentScrip Then
            ' 计算剩余持仓总成本与未实现利润
            Dim totalRemainingQty As Double, totalRemainingCost As Double
            totalRemainingQty = 0
            totalRemainingCost = 0
            Dim pos As Variant
            For Each pos In buyPositions
                totalRemainingQty = totalRemainingQty + pos(1)
                totalRemainingCost = totalRemainingCost + pos(2) * pos(1)
            Next pos
            marketPrice = ws.Cells(lastRow, 6).Value
            unrealizedProfit = marketPrice * totalRemainingQty - totalRemainingCost
            
            ' 写入上一只股票的计算结果
            ws.Cells(lastRow, 10).Value = preQtrProfit
            ws.Cells(lastRow, 11).Value = thisQtrProfit
            ws.Cells(lastRow, 12).Value = unrealizedProfit
            
            ' 重置为新股票的初始状态
            currentScrip = ws.Cells(currentRow, 1).Value
            preQtrProfit = 0
            thisQtrProfit = 0
            unrealizedProfit = 0
            Set buyPositions = New Collection
        End If
        
        lastRow = currentRow ' 记录当前股票的最后一行
        
        If ws.Cells(currentRow, 2).Value = "buy" Then
            ' 存入买入仓位：(日期, 数量, 单价)
            buyPositions.Add Array(ws.Cells(currentRow, 3).Value, _
                                  ws.Cells(currentRow, 4).Value, _
                                  ws.Cells(currentRow, 5).Value)
        ElseIf ws.Cells(currentRow, 2).Value = "sale" Then
            Dim saleQty As Double, remainingSaleQty As Double
            saleQty = ws.Cells(currentRow, 4).Value
            remainingSaleQty = saleQty
            
            ' 按FIFO顺序逐笔抵扣买入仓位
            Do While remainingSaleQty > 0 And buyPositions.Count > 0
                Dim firstPos As Variant
                firstPos = buyPositions(1)
                
                If firstPos(1) <= remainingSaleQty Then
                    ' 完全抵扣该笔买入仓位
                    Dim totalProfit As Double
                    totalProfit = (ws.Cells(currentRow, 5).Value - firstPos(2)) * firstPos(1)
                    
                    ' 根据卖出日期归类利润
                    If ws.Cells(currentRow, 3).Value <= QTR_START_DATE Then
                        preQtrProfit = preQtrProfit + totalProfit
                    ElseIf ws.Cells(currentRow, 3).Value <= QTR_END_DATE Then
                        thisQtrProfit = thisQtrProfit + totalProfit
                    End If
                    
                    remainingSaleQty = remainingSaleQty - firstPos(1)
                    buyPositions.Remove 1 ' 删除已抵扣的仓位
                Else
                    ' 部分抵扣该笔买入仓位
                    Dim partialProfit As Double
                    partialProfit = (ws.Cells(currentRow, 5).Value - firstPos(2)) * remainingSaleQty
                    
                    If ws.Cells(currentRow, 3).Value <= QTR_START_DATE Then
                        preQtrProfit = preQtrProfit + partialProfit
                    ElseIf ws.Cells(currentRow, 3).Value <= QTR_END_DATE Then
                        thisQtrProfit = thisQtrProfit + partialProfit
                    End If
                    
                    ' 更新该笔买入仓位的剩余数量
                    firstPos(1) = firstPos(1) - remainingSaleQty
                    buyPositions.Remove 1
                    buyPositions.Add firstPos, Before:=1
                    
                    remainingSaleQty = 0
                End If
            Loop
        End If
        
        currentRow = currentRow + 1
    Loop
    
    ' 处理最后一只股票的计算结果
    Dim totalRemainingQtyFinal As Double, totalRemainingCostFinal As Double
    totalRemainingQtyFinal = 0
    totalRemainingCostFinal = 0
    Dim posFinal As Variant
    For Each posFinal In buyPositions
        totalRemainingQtyFinal = totalRemainingQtyFinal + posFinal(1)
        totalRemainingCostFinal = totalRemainingCostFinal + posFinal(2) * posFinal(1)
    Next posFinal
    marketPrice = ws.Cells(lastRow, 6).Value
    unrealizedProfit = marketPrice * totalRemainingQtyFinal - totalRemainingCostFinal
    
    ws.Cells(lastRow, 10).Value = preQtrProfit
    ws.Cells(lastRow, 11).Value = thisQtrProfit
    ws.Cells(lastRow, 12).Value = unrealizedProfit
End Sub

修复说明 #

1. 严格实现FIFO规则：用Collection存储每笔买入的详细仓位信息，卖出时按顺序逐笔抵扣，彻底解决多笔卖出的计算错误
2. 仅买入无卖出场景修复：遍历剩余买入仓位计算累计总成本，不再依赖错误的单笔买入价，正确计算未实现利润
3. 未实现盈亏计算修正：直接套用公式剩余数量×市价 - 剩余持仓总成本，逻辑清晰准确
4. 代码规范优化：修复totalSold未初始化的问题，使用工作表对象避免全局Cells的潜在错误，代码结构更易维护

内容的提问来源于stack exchange，提问作者pradeep