Question

我想创建一个列表，列出不同数量的股票之间所有可能的百分比分割（建立适当的投资机会集所需的任务）。我能够为3种不同的输入创建一个宏（代码如下）。

是否可以升级该宏，以便它自动考虑输入数量（即股票行情）而无需每次都调整代码？因此，如果输入是5个代码而不是3个，它将为5个代码创建所有可能分割的列表？

电子表格布局很简单：在第1行中，每列都有一个单独的自动收报机（目前有3个代码），下面提供了拆分：

     ColumnA ColumnB ColumnC
row1 Ticker1 Ticker2 Ticker3
row2    0       0      100   
row3    0       1      99
etc.

这是我用于3个输入的内容：

Sub PercentageSplits()

Dim Lastcol As Integer
Lastcol = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
Sheet1.Cells(1, Lastcol + 1).Value = "Total"
Sheet1.Cells(1, Lastcol + 1).Font.Bold = True

Dim row As Integer: row = 2

Dim i As Integer, j As Integer, k As Integer

For i = 0 To 100: For j = 0 To 100: For k = 0 To 100
    If i + j + k = 100 Then
        Sheet1.Cells(row, 1).Value = i
        Sheet1.Cells(row, 2).Value = j
        Sheet1.Cells(row, 3).Value = k
        Sheet1.Cells(row, Lastcol + 1).Value = i + j + k
        row = row + 1
    End If
Next: Next: Next

End Sub

Answer 1

我把一个快速程序放在一起计算这些，并且在5个代码中共有100个分割，我得到了超过450万个结果（准确地说是4,598,126）。这太多了，无法放在Excel工作表上。

为了确保输出适合Excel工作表，我通过计算添加到50然后将结果加倍的5个代码组合来减半精度。这给出了316,251个结果。

如果您需要完全精确，那么您可以调整代码以每个工作表的100万行的块输出数据

我不经常在VBA中使用递归，但这似乎是回答这个特定问题的明显方法。我将在代码下面解释一些细节：

Option Explicit

' We'll store each result here
Dim splitList As Collection


Sub main()

Dim splitResult As Variant
Dim splitArray As Variant
Dim splitEntry As Variant
Dim outputArray() As Variant
Dim outputRow As Long
Dim outputCol As Long

' Initial set-up
Const TOTAL_TO_SPLIT As Integer = 50
Const NO_OF_TICKERS As Integer = 5
Set splitList = New Collection

' Generate the list
findSplit TOTAL_TO_SPLIT, 1, NO_OF_TICKERS, ""

MsgBox splitList.Count

' Output the list
ReDim outputArray(1 To splitList.Count, 1 To NO_OF_TICKERS)
outputRow = 1
With Worksheets("Sheet1")
    .UsedRange.Clear
    For Each splitResult In splitList
        outputCol = 1
        If Len(splitResult) > 0 Then
            splitArray = split(splitResult, ";")
            For Each splitEntry In splitArray
                outputArray(outputRow, outputCol) = splitEntry * 2
                outputCol = outputCol + 1
            Next splitEntry
        End If
        outputRow = outputRow + 1
    Next splitResult

    .Cells(2, 1).Resize(splitList.Count, NO_OF_TICKERS).Value = outputArray
End With

End Sub

' This sub is intended to be called recursively and will add an entry
' to splitList after each recursion concludes
Sub findSplit(amountToSplit As Integer, currentTicker As Integer, _ 
    totalTickers As Integer, resultSoFar As String)

Dim i As Integer

' Call DoEvents to prevent Excel from showing as "Not Responding"
DoEvents

' Check if this is the last ticker
If (currentTicker = totalTickers) Then
    splitList.Add resultSoFar & amountToSplit
Else
    For i = 0 To amountToSplit
        ' Otherwise, generate all the possible splits by recursion
        findSplit (amountToSplit - i), (currentTicker + 1), _
            totalTickers, (resultSoFar & i & ";")
    Next i
End If

End Sub

注意：

这不会很快跑。我建议您在运行宏之前在Visual Basic编辑器中调出Locals窗口（View＆gt; Locals窗口），这样您就可以定期使用Ctrl-Break来检查进度
你可以删除集合并直接写入2D数组，但我试图尽可能简单地保持代码的递归部分

通过向后工作可能最容易理解递归子（findSplit）。如果我们在最终的股票代码上（所以currentTicker = totalTickers），那么我们只有一种可能性：在所有之前的代码需要分配给最终的股票代码之后剩下的金额。

如果我们备份一个级别，如果我们在倒数第二个自动收报机并且剩余金额为1，那么我们有两个选择。将0分配给倒数第二个股票代码并将1传递给最后一个股票代码或将1分配给倒数第二个股票代码并将0传递给最后一个股票代码。将事物扩展到更多的代码和/或更大的数量只是重复这两个相同的规则：

如果这是最后一个自动收报机，请将剩余的内容分配给此自动收报机
如果这不是最后一个自动收报机，请尝试分配剩余的任何内容，并将剩余的内容传递给下一个自动收报机

每个股票代码将其分配的金额添加到由最后一个股票代码添加到集合中的字符串。条目14; 6; 0; 13; 17表示自动收报机1被分配了14，自动收报机2被分配了6，依此类推。如上所述，我通过计算分配总数为50来减少结果数量，然后将结果加倍。因此，14; 6; 0; 13; 17组合将输出为28; 12; 0; 26; 34（并且您将在输出工作表的第228559行中找到它。）

使用Split和For Each ... Next循环的主子代码将存储在集合中的字符串转换为我们可以直接删除到工作表的2D数字数组

列出＆gt; 3个输入

1 个答案: