Question

我正在根据FIFO会计原则（先进先出）做自动化我的分类账的工作，其中任何被称为对冲余额的东西都会从第一个条目中减去，然后是第二，直到该变量为零（或者如果有剩余开始新的会计行）。

一般来说，我一直在为这个分类帐添加一个新职位（而不是简单地创建一个行项目来删除任何余额）...

Tickerstring = TTB 'TTB is the user defined input for the ticker

tickercolumn = HBWS.Cells.Find(What:="Ticker").Column 'Use this to identify 
what column the ticker field is

Set TickerResult = HBWS.Cells.Find(What:=TickerString, LookIn:=xlValues)
If Not TickerResult Is Nothing Then
tickerRow = TickerResult.Row
Else
End If 'Identifies the row which the actual Ticker is in i.e. the TTB

HBWS.Cells(tickerRow, tickercolumn) = TTB

我使用相同的概念来定义股票数量，以及它们是多头还是做空。将Userform输入插入相应的单元格。

我的问题是，我说我运行该代码3次，现在有3行项目看起来像这样

AAPL 300 Long

AAPL 100 Long

然后我想为600短线添加一个新位置，它将通过FIFO会计处理并从第一行中删除300，从第二行中删除100，从第三行中删除100，然后创建一个100短的新线。我该怎么做呢？

我想我会从用户定义的变量中减去，即从第一行中取出300，现在我定义的变量保留在300（当它从600开始时）。

基本上我认为描述这个的最好方法是如何根据当前工作簿值从变量中减去，然后在我的子过程中继续使用它。

编辑：为清晰起见编辑我的帖子

我的电子表格中有以下条目

我想运行我的宏来获取我在下面的用户表格中显示的空头头寸，从当前我的电子表格中减去它，然后创建一个表示空头位置剩下的剩余线

结束状态应如下所示

如果您需要其他信息，请告诉我

Answer 1

<强>要求：

维护从用户表单输入（一次一个）生成的共享事务分类帐。
计算＆amp;使用FIFO库存评估方法显示股票的净头寸。

提议的解决方案：
可以使用以下方法实现这些要求：

A ListObject包含交易分类帐并计算每笔交易后的结束位置。
PivotTable显示共享的结束位置（以及所需的任何其他报告）。

下图显示了建议的ListObject和PivotTable

2

ListObject字段：

来自用户表单的输入

代码： 分享符号。
L / S： 分享位置（长\短）。
很多： 股票数量。

按VBA程序计算

L / S.Net： 净资产头寸（长\短）。
数量： 净份额（绝对值）。
Lots.Net： 净分享数量。
T：记录类型（P：Prior \ R：Residual），用于标记共享的最新交易。
TimeStamp： 记录日期＆amp;发布时间，用于应用FIFO估值方法。

VBA程序： 请参阅过程中插入的说明\ coments。

Option Private Module
Option Compare Text
Option Explicit
Option Base 1
Rem Updated 20180504_121918

Sub ListObject_Stocks_Ledger_FIFO(vRcrd As Variant)
Dim aFlds As Variant, vFld As Variant
aFlds = [{"Ticker","L/S","Lots","T","TimeStamp","Lots.Net","L/S.Net","Qty"}]
Dim lo As ListObject, pt As PivotTable
Dim sTicker As String, lCnt As Long, lPos As Long
Dim lRow As Long, bCol As Byte, b As Byte
Dim sFml As String
Dim vValue As Variant
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Rem Set Objects
    With ThisWorkbook.Worksheets("Sht(0)")      'change as required
        Application.Goto .Cells(1), 1
        Set pt = .PivotTables("ptPositions")
        Set lo = .ListObjects("loPositions")
    End With

    With lo

        Rem Set ListObject New Row
        lRow = 1 + .ListRows.Count
        Select Case lRow
        Case 1
            Rem ListObject with zero records
            .HeaderRowRange.Cells(2, 1).Value2 = "!NEW"

        Case Else
            vFld = "Ticker"
            sTicker = vRcrd(1)
            bCol = .ListColumns(vFld).Index
            lCnt = WorksheetFunction.CountIfs(.DataBodyRange.Columns(bCol), sTicker)

            Rem Flag prior Ticker records
            Select Case lCnt
            Case 0
                Rem New Ticker - NO ACTION

            Case 1
                Rem Ticker with only one prior record
                lPos = WorksheetFunction.Match(sTicker, .DataBodyRange.Columns(bCol), 0)
                .ListColumns("T").DataBodyRange.Cells(lPos).Value2 = "P"

            Case Else
                Rem Ticker with only one prior record
                .Range.AutoFilter Field:=bCol, Criteria1:=sTicker
                .ListColumns("T").DataBodyRange.SpecialCells(xlCellTypeVisible).Value2 = "P"
                .Range.AutoFilter

        End Select: End Select

        Rem Add New Record
        For Each vFld In aFlds
            b = 1 + b
            bCol = .ListColumns(vFld).Index

            Rem Set Field Value\Formula
            sFml = vbNullString
            vValue = vbNullString
            Select Case vFld
            Case "Ticker", "L/S", "Lots":   vValue = vRcrd(b)
            Case "T":                       vValue = "R"
            Case "TimeStamp":               vValue = CDbl(Now)
            Case "L/S.Net"
                sFml = "=IF(NOT(EXACT([@T],'R')),CHAR(39)," & vbLf _
                    & "IF([@[Lots.Net]]<0,'Short',IF([@[Lots.Net]]>0,'Long','Zero')))"

            Case "Qty"
                sFml = "=IF(NOT(EXACT([@T],'R')),CHAR(39)," & vbLf _
                    & "ABS([@[Lots.Net]]))"

            Case "Lots.Net"
                sFml = "=IF(NOT(EXACT([@T],'R')),CHAR(39),SUM(" & vbLf _
                    & "SUMIFS([Lots],[Ticker],[@Ticker],[L/S],'Long',[TimeStamp],'<='&[@TimeStamp])," & vbLf _
                    & "-SUMIFS([Lots],[Ticker],[@Ticker],[L/S],'Short',[TimeStamp],'<='&[@TimeStamp])))"

            End Select

            Rem Apply Field Value\Formula
            Select Case vbNullString
            Case Is <> vValue
                .DataBodyRange.Cells(lRow, bCol).Value2 = vValue

            Case Is <> sFml
                sFml = Replace(sFml, Chr(39), Chr(34))
                With .DataBodyRange.Columns(bCol)
                    .Formula = sFml
                    .Value2 = .Value2

    End With: End Select: Next: End With

    Rem Sort ListObject
    With lo.Sort
        With .SortFields
            .Clear
            .Add Key:=lo.ListColumns("Ticker").DataBodyRange, _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            .Add Key:=lo.ListColumns("TimeStamp").DataBodyRange, _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        End With
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Rem Refresh PivotTable
    pt.PivotCache.Refresh

    Application.EnableEvents = False
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = False

    End Sub

使用此过程模拟用户表单中的发布：

Sub ListObject_Stocks_Ledger_FIFO_TEST()
Dim aDATA As Variant, vRcrd As Variant
aDATA = Array( _
    Array("AAPL", "Long", "300"), _
    Array("AAPL", "Long", "100"), _
    Array("AAPL", "Long", "100"), _
    Array("AAPL", "Short", "600"), _
    Array("BCS", "Long", "300"), _
    Array("BCS", "Long", "100"), _
    Array("BCS", "Short", "500"), _
    Array("Test", "Long", "100"), _
    Array("Test", "Long", "200"), _
    Array("Test", "Long", "300"), _
    Array("Test", "Short", "400"))

    For Each vRcrd In aDATA
        Call ListObject_Stocks_Ledger_FIFO(vRcrd)
: Stop
    Next

    End Sub

Answer 2

这可能是您想要做的一个例子，希望对您有用：

Sub test()

Dim reduce_amount As String
reduce_amount = Val(InputBox("Number:"))

Dim cell As Range

For Each cell In Selection

cell_value = Mid(cell.Value, 6, 3)

If IsNumeric(cell_value) Then
    reduce_amount = reduce_amount - cell_value
End If

Next cell

If reduce_amount > 0 Then
 Selection.End(xlDown).Offset(1, 0).Value = "AAPL " & reduce_amount & " Long"
End If

End Sub

Answer 3

我认为你应该这样做，所以每笔交易都是自己的（除非你有充分的理由不这样做）。我从不存储＆＃34;州＆＃34;如果可能，在一个单元格中如何跟踪每个桶。这是一个例子

Public Sub AddLots(ByVal Ticker As String, ByVal Lot As Double)

    Dim rCell As Range
    Dim LotRemains As Double
    Dim dc As Scripting.Dictionary
    Dim dToTake As Double
    Dim ThisTicker As String, ThisLS As String, ThisLot As Double, ThisBucket As Long, ThisTotal As Double
    Dim lo As ListObject
    Dim aOutput() As Variant
    Dim MaxBucket As Long
    Dim i As Long

    LotRemains = Lot
    Set dc = New Scripting.Dictionary
    Set lo = Sheet1.ListObjects(1)

    For Each rCell In lo.ListColumns(1).DataBodyRange.Cells
        'Store this row's values
        ThisTicker = rCell.Value: ThisLS = rCell.Offset(0, 1).Value: ThisLot = rCell.Offset(0, 2).Value
        ThisBucket = rCell.Offset(0, 3).Value: ThisTotal = rCell.Offset(0, 4).Value

        'if the ticker is the same
        If ThisTicker = Ticker Then
            'if it's going the opposite way of our transaction
            If (Lot > 0 And ThisLS = "Short") Or _
                (Lot < 0 And ThisLS = "Long") Then

                'if there's still something left in the bucket
                If ThisTotal <> 0 Then
                    If Abs(ThisTotal) >= Abs(LotRemains) Then
                        dToTake = LotRemains
                    Else
                        dToTake = -ThisTotal
                    End If
                    'store this bucket
                    dc.Add ThisTicker & "|" & ThisBucket, dToTake
                    'reduce the amount left to test
                    LotRemains = LotRemains - dToTake
                    'stop looking if we've used it all up
                    If LotRemains = 0 Then Exit For
                End If
            End If
        End If
    Next rCell

    'this is an array we'll write out to the worksheet
    ReDim aOutput(1 To dc.Count + IIf(LotRemains <> 0, 1, 0), 1 To 4)

    'for every bucket we saved, put it in the array
    For i = 1 To dc.Count
        aOutput(i, 1) = Ticker
        aOutput(i, 2) = IIf(Lot > 0, "Long", "Short")
        aOutput(i, 3) = Abs(dc.Items(i - 1))
        aOutput(i, 4) = Split(dc.Keys(i - 1), "|")(1)
    Next i

    'if we couldn't use it all up, get the next bucket number
    If LotRemains <> 0 Then
        For Each rCell In lo.ListColumns(1).DataBodyRange.Cells
            If rCell.Value = Ticker Then
                If rCell.Offset(0, 3).Value > MaxBucket Then
                    MaxBucket = rCell.Offset(0, 3).Value
                End If
            End If
        Next rCell

        'then add a new bucket to the array
        aOutput(dc.Count + 1, 1) = Ticker
        aOutput(dc.Count + 1, 2) = IIf(Lot > 0, "Long", "Short")
        aOutput(dc.Count + 1, 3) = Abs(LotRemains)
        aOutput(dc.Count + 1, 4) = MaxBucket + 1
    End If

    'write out the new transactions to the worksheet
    lo.ListRows.Add.Range.Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput

End Sub

从这里开始

然后运行AddLots "BCS", 400并获取

然后运行AddLots "BCS", -1000并获取

然后使用数据透视表通过自动收报机，数据桶或其他任何内容查看您的位置

表格最后一栏的公式是

=SUMPRODUCT(([Ticker]=[@Ticker])*([Bucket]=[@Bucket])*([LS]="Long")*([Lots]))-SUMPRODUCT(([Ticker]=[@Ticker])*([Bucket]=[@Bucket])*([LS]="Short")*([Lots]))

Answer 4

我查看了所有发布的答案，并从每个答案中提出了一些想法。我使用下面的代码来控制变量，然后我有其他代码使用最终变量来编译所有内容。

虽然清除其他批次并定义变量的代码部分位于

之下

Dim rCell As Range
Dim reduce_amount As Variant
Dim HBWS As Worksheet
Dim TickerTotalString As String
TickerTotalString = "Total " & TTB
Set HBWS = Sheets("Hedgebook")
Dim FormulaWS As Worksheet
Set FormulaWS = Sheets("Formula_Template")

LastHBR = HBWS.Cells(HBWS.Rows.Count, "B").End(xlUp).Row
ClastHBC = HBWS.Cells(3, HBWS.Columns.Count).End(xlToLeft).Column
LastFWSR = FormulaWS.Cells(FormulaWS.Rows.Count, "B").End(xlUp).Row
CLASTFWSC = FormulaWS.Cells(3, FormulaWS.Columns.Count).End(xlToLeft).Column


Tickercolumn = HBWS.Cells.Find(What:="Ticker").Column
Datecolumn = HBWS.Cells.Find(What:="Date&Time Booked").Column
LScolumn = HBWS.Cells.Find(What:="L/S").Column
Lotscolumn = HBWS.Cells.Find(What:="Lots").Column
Conversioncolumn = HBWS.Cells.Find(What:="Conversion Cents").Column
Borrowcolumn = HBWS.Cells.Find(What:="Borrow (bps)").Column

Set Tickerresult = HBWS.Cells.Find(What:=TickerTotalString, LookIn:=xlValues)
If Not Tickerresult Is Nothing Then
Tickerrow = Tickerresult.Row
Else
End If

reduce_amount = LTB 'Userform input that defines the total lots



If reduce_amount > 0 Then
For Each rCell In HBWS.Range(Cells(3, Tickercolumn), Cells(LastHBR, Tickercolumn))
    If rCell.Value = TTB And rCell.Offset(0, -1).Value <> TickerTotalString And reduce_amount > 0 Then
    Cell_value = rCell.Offset(0, 3).Value
        If reduce_amount < Cell_value Then
        rCell.Offset(0, 3).Value = Cell_value - reduce_amount
        ElseIf reduce_amount > Cell_value Then
        rCell.Offset(0, 3).Value = 0
        reduce_amount = reduce_amount - Cell_value
        ElseIf reduce_amount = Cell_value Then
        reduce_amount = 0
        rCell.Offset(0, 3).Value = 0
        End If
    End If
Next
End If

从变量中减去值，直到该变量为0 Excel VBA

4 个答案: