列出> 3个input的所有可能的百分比分割

我想创build一个不同数量的股票之间的所有可能的百分比拆分清单(build立适当的投资机会集所需的任务)。 我能够创build一个为3个不同的input定制的macros(代码如下)。

是否可以升级macros,以便自动考虑input数量(即股票代码)而不必每次都调整代码? 因此,如果input是5代表而不是3,那么它将创build5个代号的所有可能拆分的列表?

电子表格的布局很简单:在第一行中,我在每一列中都有一个单独的行情(现在是三个行情),分割如下:

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

以下是我用于3个input的内容:

 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个结果。

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

我不经常在VBA中使用recursion,但它似乎是回答这个特定问题的显而易见的方法。 我将在代码下面解释一些细节:

 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 

笔记:

  • 这不会很快。 我build议你在运行macros之前在Visual Basic编辑器中调出Locals窗口(View> Locals窗口),这样你可以定期的使用Ctrl-Break来检查进度
  • 你可以消除集合,直接写入二维数组,但我试图保持代码的recursion部分尽可能简单

通过反向工作来理解recursion子(findSplit)可能是最容易理解的。 如果我们在最后一个股票代码(currentTicker = totalTickers),那么我们只有一个可能性:在所有先前的代码需要分配给最后的股票代码之后剩余的数量。

如果我们支持一个水平,如果我们是在倒数第二个,剩余的数量是1,那么我们有两个select。 为倒数第二个分配器分配0,并将1传递给最后一个dynamic分配器,或者为倒数第二个动作者分配1,并将0传递给最后一个dynamic分配器。 把事情扩展到更多的代价和/或更大的数额只是这两个规则的重复:

  • 如果这是最后一个股票,分配剩下的东西给这个股票
  • 如果这不是最后一个股票,请尝试每一个可能的分配给剩下的股票,并把剩下的东西传给下一个股票

每个代码行将添加的数量分配给由最后一个代码行添加到集合中的string。 一个条目14; 6; 0; 13; 17显示了自动收报机1被分配了14,自动收报机2被分配了6等等。 如上所述,我通过计算总共50个分配结果来减less结果数量,然后将结果加倍。 因此,14; 6; 0; 13; 17的组合将输出为28; 12; 0; 26; 34(您可以在输出工作表中的228559行中find它)。

使用Split的主子代码和For Each … Next循环中的代码将存储在集合中的string转换为二维数组数组,这些数字可以直接放在工作表中