我想创建一个列表，列出不同数量的股票之间所有可能的百分比分割（建立适当的投资机会集所需的任务）。我能够为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万个结果（准确地说是4,598,126个）。太多了，无法放在Excel工作表中。
为了确保输出适合Excel工作表，我通过计算5个股票的组合（将这些股票添加到50个股票中然后将结果加倍）来将精度减半。这给出了316,251个结果。
如果需要全精度，则可以修改代码以每个工作表以一百万行的块形式输出数据
我不经常在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
笔记：
通过反向工作，最容易理解递归子（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数字数组，我们可以将其直接放置到工作表上
本文收集自互联网，转载请注明来源。
如有侵权，请联系 [email protected] 删除。
我来说两句