从互斥选项中生成所有可能的select组合

我有一个优化问题，需要我testing潜在投资组合的所有潜在select组合，我也需要能够快速适应排除某些select。

这必须在Excel中完成。

下面是我的清理示例的规则：

• 我可以select从3家杂货店购买水果
• 杂货店可能有不同数量的过道，以及不同的水果组合
• 我只能从所有的杂货店里挑选一种水果（或者根本不选）

组合

1. 我的第一个组合是没有任何杂货店的成果
2. 在接下来我从Grocer3从Aisle 3挑选苹果
3. 然后从Grocer3的 过道2的 苹果
4. 然后从Grocer3的 Aisle 1 苹果
5. 然后我从Grocer2的 Aisle 2中挑选苹果 ，而Grocer 3则没有任何东西（比如Grocer 3和组合1等的select一样）
6. 那么我从Grocer2的 Aisle 2中挑选苹果 ，从Grocer3的 Aisle 3中挑选苹果 （也就是从Grocer 3中select的组合2）等等

所有这一切将给我7*4*4 = 112可能的组合

• 杂货商1的 7个select（6selectselect+ 1什么都不做）
• 杂货商2的 4个select（3selectselect+ 1什么都不做）
• 杂货商3的 4个select（3selectselect+ 1什么都不做）

1.无约束的问题

我的实际问题要复杂得多，但基本结构是成立的。

我想要做的是有一个excel公式或vba方法来填充所有可用的选项：

1. 无约束的问题。
2. 一个约束的问题（例如，当我closures过道2给我45个有效的组合）

2.约束问题

我曾经尝试过

我确实解决了菜单选项数量与MOD\INT方法相同的一个初始问题。 这是简单的一个单一的公式，因为模式是可重复的。

如果有一个聪明的配方解决scheme，那么这将是首选，但我打开代码（这是我正在尝试的路线）

Answer 1

在这个专家交换PAQ http://rdsrc.us/qdl6tl我工作了一个非常类似的问题来枚举五个不同类别的东西的每一个组合。 每个类别中的事物数量都是不同的。 列举必须考虑在一个类别中没有select的可能性以及从该类别中抽取的任何一个select。

我把这个问题写成了一个五位数的数字，其中数字中每个位置的可能数字是一个variables。

 Sub CombinatrixPlus() 'Forms all the combinations of at least two subattributes taken from a selection. _ No more than one subattribute may be taken from any row. 'Uses variable base counting method Dim i As Long, ii As Long, j As Long, k As Long, lenSep As Long, _ m As Long, mCol As Long, mSheet As Long, mRow As Long, _ N As Long, nBlock As Long, nMax As Long, nWide As Long Dim v As Variant, vInputs As Variant, vResults As Variant Dim rg As Range, rgDest As Range Dim ws As Worksheet Dim s As String, sep As String Application.ScreenUpdating = False sep = ", " 'Separator substring between each subattribute in results Set ws = Worksheets("Sheet2") 'Put first batch of results in this worksheet Set rgDest = ws.[A2] 'Put results starting in this cell mSheet = rgDest.Worksheet.Index mCol = rgDest.Column lenSep = Len(sep) Set rg = Selection 'Cells containing the subattributes nBlock = 16384 'Maximum number of values in results array 'Clear the previous results Application.DisplayAlerts = False For i = Worksheets.Count To ws.Index Step -1 Worksheets(i).Cells.Clear 'Clear the cells If i > ws.Index Then Worksheets(i).Delete 'Delete the sheet Next Application.DisplayAlerts = True N = rg.Rows.Count nWide = N 'If results lists subattributes in separate cells 'nWide = 1 'If results lists subattributes as a single string with separators ReDim v(N, 1 To 2) vInputs = rg.Value v(0, 2) = 1 For i = 1 To N v(i, 1) = Application.CountA(rg.Rows(i)) v(i, 2) = (v(i, 1) + 1) * v(i - 1, 2) Next nMax = v(N, 2) - 1 ReDim vResults(1 To nBlock, 1 To nWide) For i = 1 To nMax s = "" m = 0 ii = ii + 1 For j = 1 To N k = (i Mod v(j, 2)) \ v(j - 1, 2) If k <> 0 Then m = m + 1 If nWide > 1 Then vResults(ii, j) = vInputs(j, k) s = s & sep & vInputs(j, k) End If Next s = Mid$(s, lenSep + 1) If nWide = 1 Then vResults(ii, 1) = s 'Results in a concatentated string If m < 2 Then ii = ii - 1 If ii = nBlock Then Application.StatusBar = "Now posting combination " & i & " of " & nMax mRow = rgDest.Worksheet.Cells(Rows.Count, mCol).End(xlUp).Row If rgDest.Worksheet.Cells(mRow, mCol) <> "" Then mRow = mRow + 1 If mRow < rgDest.Row Then mRow = rgDest.Row If (Rows.Count - mRow) >= nBlock Then rgDest.Worksheet.Cells(mRow, mCol).Resize(nBlock, nWide).Value = vResults Else mSheet = mSheet + 1 If Worksheets.Count < mSheet Then Worksheets.Add After:=Worksheets(mSheet - 1) With ActiveSheet Set rgDest = .Range(rgDest.Address) For j = 1 To N .Columns(j).ColumnWidth = ws.Columns(j).ColumnWidth Next mRow = rgDest.Row .Cells(mRow, mCol).Resize(nBlock, nWide).Value = vResults End With End If ii = 0 ReDim vResults(1 To nBlock, 1 To nWide) End If Next If ii > 0 Then Application.StatusBar = "Now posting combination " & i & " of " & nMax mRow = rgDest.Worksheet.Cells(Rows.Count, mCol).End(xlUp).Row If rgDest.Worksheet.Cells(mRow, mCol) <> "" Then mRow = mRow + 1 If mRow < rgDest.Row Then mRow = rgDest.Row If (Rows.Count - mRow) >= nBlock Then rgDest.Worksheet.Cells(mRow, mCol).Resize(nBlock, nWide).Value = vResults Else mSheet = mSheet + 1 If Worksheets.Count < mSheet Then Worksheets.Add After:=Worksheets(mSheet - 1) With ActiveSheet Set rgDest = .Range(rgDest.Address) For j = 1 To N .Columns(i).ColumnWidth = ws.Columns(j).ColumnWidth Next mRow = rgDest.Row .Cells(mRow, mCol).Resize(nBlock, nWide).Value = vResults End With End If i = rgDest.Worksheet.UsedRange.Rows.Count 'Reset the scrollbar End If Application.StatusBar = False 'Clear the status bar Application.ScreenUpdating = True End Sub