Excel 列出>；3输入

我想创建一个列表，列出不同数量股票之间所有可能的百分比分割（这是建立适当的投资机会集所必需的任务）。我能够为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

---

我把一个快速的程序放在一起计算这些结果，在5个股票代码中，总共有100个，我得到了450多万个结果（准确地说是4598126）。这太多了，不能放在Excel表格上

为了确保输出符合Excel表格的要求，我计算了5个标记的组合，加上50，然后将结果加倍，从而将精度减半。这给出了316251个结果

如果您需要完全精确，那么您可以调整代码，以每个工作表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编辑器中打开“局部变量”窗口（视图>局部变量窗口），以便定期使用Ctrl-Break检查进度
• 您可以消除集合，直接写入2D数组，但我试图使代码的递归部分尽可能简单

通过向后操作，可能最容易理解递归子函数（findSplit）。如果我们在最终报价器上（因此currentTicker=totalTickers），那么我们只有一种可能性：之前所有报价器的剩余金额需要分配给最终报价器

如果我们回到一个水平，如果我们在第二个最后的股票行情，剩余的金额是1，那么我们有两个选择。将0分配给倒数第二个股票代码并将1传递给倒数第二个股票代码，或将1分配给倒数第二个股票代码并将0传递给倒数第二个股票代码。将事情扩展到更多的股票和/或更多的金额只是重复这两条相同的规则：

• 如果这是最后一个代码，则将剩余的代码分配给该代码
• 如果这不是最后一个股票代码，请尝试所有可能分配给该股票代码的内容，并将剩余的内容传递给下一个股票代码

每个ticker将分配给它的金额添加到一个字符串中，该字符串由最后一个ticker添加到集合中。14条；6.0;13;17表示股票代码1已分配14，股票代码2已分配6，依此类推。如上所述，我通过计算总共50项的分配来减少结果数量，然后将结果加倍。因此，14个国家；6.0;13;17个组合的输出为28个；12;0;26;34（您可以在输出工作表的第228559行中找到它）

---

在主子程序中的代码使用Split和For Each。。。下一个循环将集合中存储的字符串转换为二维数字数组，我们可以将其直接放到工作表中。很抱歉没有早点回复，我出差去了。我还没有机会尝试你的建议，尽管背后的逻辑似乎很可靠。真的很想谢谢你花时间帮我！当我有机会在excel中运行它时，我会回复！嗨，barrowc，终于有时间尝试一下你的代码了——工作起来很有魅力。而且速度也非常快！最长为30秒，具体取决于报价器数量/拆分百分比。更新了一点，使股票的数量成为一个变量，所以非常感谢你！