组合在excel中：找到每一个可能的组合的每一个可能的总和 [英] Combinatorics in excel: Find every possible sum of every possible combination
问题描述
我有个人名单（col。A ），并且它们中的每一个具有为确定的参数（col。B）分配的值。
我有一些目标参数值，我想知道个人的哪些组合总结了该参数值的x。
让我们例如：
中学B
M 10
N -5
O -8
P 0.87
Q 9
- 参数（X）的目标：9-10
- 解决方案：
S1 = Q + P - > 9.87
S2 = Q - > 9
正如你所看到的，只有通过检查，唯一的方法是采取Q或Q + P。
但是在我的情况下，我每次都有10-15个科目，而且通过检查进行工作并不容易。
我想要生成具有所有可能值的图表（能够知道哪些主题产生价值），或者只是一种了解y最接近的组合。
原来的问题涉及到5个可接受的强力方法的值。然后增加值的数量，需要更复杂的方法。我建议你从这个答案开始，其中描述了暴力方法，其次是：
第一个答案
您需要通过一些简单的步骤来解决您的需求。可能会组合两个或多个步骤，但复杂的步骤需要更多的时间来编写和更多的时间进行调试。开始简单一旦您的代码正常运行，您可以担心更快，更漂亮或任何必要的事情。太多的程序员忘记了那些不起作用的快速，漂亮的代码是无用的。
我创建了一个工作表Source，并使用值填充：
我需要将最小值和最大值放在某处，以便将它们放在这个工作表上。
我创建了一个工作表Result。下面的宏的输出是：
您不会列出10 M作为解决方案。我不知道这是否是监督，或者你对9-10范围的解释与我的不同。如果需要，更改行如果ValueMin< = ValueCrnt和ValueMax> = ValueCrnt Then
我注意到我的列与你的列不一样。这是一个容易的改变，我为你做一个练习。
我的解决方案有三个主要步骤。
步骤1
在我的工作表中，相关数据位于第2行到第6行。您表示您需要添加更多值。起始行是固定的，所以我已经使用常量来定义它：
Const RowSrcDataFirst As Long = 2
包含数据的最后一行 RowSrcDataLast 的值由代码
步骤2
尽管您的目标是处理密钥和值在这个阶段你对这些行感兴趣例如：
- 行2上的值是否在所需范围内？
- 第2行和第3行的值在所需范围内？
- 行2,4和6之间的值是否在所需范围内的总和？
如果任何这些问题的答案为是，则从密钥创建表达式。
您需要行号来获取关键字和值。
我的宏将数组 SrcRows 与值2到 RowSrcDataLast 。然后调用子程序 GenerateCombinations 。我使用这个子例程的变体来解决这种类型的任何问题。
GenerateCombinations 将两个数组作为参数，值和 Result 加上一个分隔符。返回时， Result 返回一个数组，其中包含值中每个值组合的连接字符串。如果值包含值2,3,4,5和6，则返回的字符串为：
Inx组合
0
1 2
2 3
3 2 | 3
4 4
5 2 | 4
6 3 | 4
7 2 | 3 | 4
8 5
9 2 | 5
10 3 | 5
11 2 | 3 | 5
12 4 | 5
13 2 | 4 | 5
14 3 | 4 | 5
15 2 | 3 | 4 | 5
16 6
17 2 | 6
18 3 | 6
19 2 | 3 | 6
20 4 | 6
21 2 | 4 | 6
22 3 | 4 | 6
23 2 | 3 | 4 | 6
24 5 | 6
25 2 | 5 | 6
26 3 | 5 | 6
27 2 | 3 | 5 | 6
28 4 | 5 | 6
29 2 | 4 | 5 | 6
30 3 | 4 | 5 | 6
31 2 | 3 | 4 | 5 | 6
我认为在例行程序中有足够的评论来解释如何产生这个结果。
步骤3
宏循环返回的数组，分割返回的字符串并访问该组合的每一行。
我希望这一切都有道理。如果有必要，回来问题，但是你可以自己解密我的代码越多，你会越快了解。
代码
Option Explicit
子控件（）
'使用常量而不是文字具有以下效果：
'1）键入代码需要更长的时间。例如：
'ValueMin = .Range（CellSrcMin）.Value需要比
'ValueMin = .Range（C3）更长的类型值
'2）文档化。 .Range（CellSrcMin）.Value
'的目的比.Range（C3）的目的更为明显。这可能
'今天不重要，但是当您在6个月内返回此宏时，自我
'记录代码是一个真正的帮助。
'3）如果单元格地址，列代码或工作表名称发生更改，那么
'所需要做的就是更改常量的值，代码是固定的。
'扫描你的代码每一次的文字，并决定是否
'需要改变是一个噩梦。
Const CellSrcMin As String =C3
Const CellSrcMax As String =D3
Const ColRsltValue As String =A
Const ColRsltKeyExpn As String = B
Const ColSrcKey As String =A
Const ColSrcValue As String =B
Const RowSrcDataFirst As Long = 2
Const WshtNameRslt As String =Result
Const WshtNameSrc As String =Source
Dim InxResultCrnt As Long
Dim InxResultPartCrnt As Long
Dim InxSrcRowCrnt As Long
Dim RowRsltCrnt As Long
（）As String
Dim ResultPart（）As String
Dim ValueCrnt As Double $
Dim ValueKey As String
Dim ValueMin As Double
Dim ValueMax As Double
'查找包含数据的最后一行
使用Worksheets（WshtNameSrc）
RowSrcDataLast = .Cells（Rows.Count，ColSrcKey）.End（xlUp）.Row
End with
'Rows R owSrcDataFirst到RowSrcDataLast包含数据。
'大小SrcRows，因此它可以保存此范围内的每个值
ReDim SrcRows（1 To RowSrcDataLast - RowSrcDataFirst + 1）
'为每个包含数据的行填充SrcRows
RowSrcCrnt = RowSrcDataFirst
对于InxSrcRowCrnt = 1到UBound（SrcRows）
SrcRows（InxSrcRowCrnt）= RowSrcCrnt
RowSrcCrnt = RowSrcCrnt + 1
下一个
'生成每一个可能的组合
调用GenerateCombinations（SrcRows，Result，|）
'结果输出到立即窗口的内容。
'完全了解
'GenerateCombinations正在做什么后，删除或注释掉。
Debug.PrintInx组合
对于InxResultCrnt = 0到UBound（Result）
Debug.Print Right（& InxResultCrnt，3）& &结果（InxResultCrnt）
下一个
'获取最小值和最大值
带有工作表（WshtNameSrc）
ValueMin = .Range（CellSrcMin）.Value
ValueMax = .Range（CellSrcMax）.Value
结束
'初始化结果工作表
带工作表（WshtNameRslt）
.Cells.EntireRow.Delete
使用.Range（A1）
.Value =Total
.HorizontalAlignment = xlRight
End with
.Range（B1）。Value =Key Expn
.Range（A1：B1）。Font.Bold = True
'如果任何组合给出可接受的值
.Range（A2），则此值将被覆盖Value = 没有组合给出范围内的值& _
ValueMin& 到& ValueMax
结束
RowRsltCrnt = 2
带工作表（WshtNameSrc）
'获取最小值和最大值
ValueMin = .Range （CellSrcMin）.Value
ValueMax = .Range（CellSrcMax）.Value
'对于除first以外的每个结果，不选择行
InxResultCrnt = 1 To UBound（Result）
ResultPart = Split（Result（InxResultCrnt），|）
ValueCrnt = 0＃
InxResultPartCrnt = 0到UBound（ResultPart）
ValueCrnt = ValueCrnt + .Cells（ResultPart （InxResultPartCrnt），ColSrcValue）.Value
下一个
如果ValueMin< = ValueCrnt和ValueMax> = ValueCrnt然后
'可接受范围内的值
工作表（WshtNameRslt）.Cells （RowRsltCrnt，ColRsltValue）= ValueCrnt
'创建键字符串
ValueKey = .Cells（ResultPart（0），ColSrcKey）.Value
For InxResultPartCrnt = 1 To UBound（ResultPart）
ValueKey = ValueKey& +& .Cells（ResultPart（InxResultPartCrnt），ColSrcKey）.Value
下一个
工作表（WshtNameRslt）.Cells（RowRsltCrnt，ColRsltKeyExpn）= ValueKey
RowRsltCrnt = RowRsltCrnt + 1
End If
下一个
结束
End Sub
Sub GenerateCombinations（ByRef Value（）As String，ByRef Result（）As String，_
ByVal Sep As String）
'*在条目中，数组值包含值。例如：A，B，C.
'*退出时，数组Result包含来自Value的值的每个可能的组合
'的一个条目。例如，如果Sep =|：
'0）'没有一个值是允许的组合
'1）A
'2）B
'3）A | B
'4）C
'5）A | C
'6）B | C
'7）A | B | C
'*边界的值可以是任何有效的范围，
'* Result的下限将为零。结果
'的上限将根据需要保存所有组合。
Dim InxRMax As Integer'数组中的最大使用条件结果
Dim InxVRCrnt As Integer'数组中的工作索引值和InxResultCrnt
Dim NumValues As Long'值
Dim InxResultCrnt（）As Long'Entry = 1 if对应值
'为此组合选择
NumValues = UBound（Value） - LBound（Value）+ 1
ReDim结果（0到2 ^ NumValues - 1）'每个组合一个条目
ReDim InxResultCrnt（LBound（Value）To UBound（Value））'每个值一个条目
'初始化InxResultCrnt为没有选择
对于InxVRCrnt = LBound（值）到UBound（值）
InxResultCrnt（InxVRCrnt）= 0
下一个
InxRMax = -1
Do While True
'输出当前结果
InxRMax = InxRMax + 1
如果InxRMax> UBound（结果）然后
'没有更多的组合输出
Exit Sub
End If
结果（InxRMax）=
对于InxVRCrnt = LBound（Value ）到UBound（Value）
如果InxResultCrnt（InxVRCrnt）= 1然后
'选择此值
如果Result（InxRMax）<> 然后
结果（InxRMax）= Result（InxRMax）&如果
结果（InxRMax）= Result（InxRMax）& Value（InxVRCrnt）
End If
Next
'将InxResultCrnt作为一个小二进制数
'处理，并将其值依次为1.忽略溢出。
'值为：
'000000000
'100000000
'010000000
'110000000
'001000000
'etc
InxVRCrnt = LBound（Value）To UBound（Value）
如果InxResultCrnt（InxVRCrnt）= 0然后
InxResultCrnt（InxVRCrnt）= 1
退出
Else
InxResultCrnt InxVRCrnt）= 0
结束如果
下一个
循环
结束子
新版本
Nuclearman对溢出的说明部分正确。数据类型整数始终指定一个16位有符号整数。这不依赖于Excel版本。数组大小不是一个限制性问题。
宏 GenerateCombinations 最初是在几年前数据类型为整数的时候写的。我没有注意到这些定义：
Dim InxRMax As Integer'数组中最大使用的条目结果
Dim InxVRCrnt As Integer 工作索引到数组Value和InxResultCrnt
它们应该被替换为：
Dim InxRMax As Long'数组中最大使用条数结果
Dim InxVRCrnt As Long'工作索引到数组Value and InxResultCrnt
数据类型Long指定一个32位有符号整数，将修复直接问题。
注意：您不应该在32位或64位计算机上使用数据类型整数，因为16位整数需要特殊（慢）处理。
表以下显示隐藏的问题：
持续时间
宏数量
键/值组合秒
5 32 0.17
10 1,024 0.24
15 32,768 3.86
16 65,536 8.02
17 131,072 16.95
18 262,144 33.04
19 524,288 67.82
20 1,048,576 142.82
25 33,554,432
30 1,073,741,824
31 2,147,483,648
N值的组合为2 ^ N。我的宏正在生成每个可能的组合，并将其作为字符串存储在数组中。使用15个值，该数组具有32,768个条目，比16位有符号整数的最大值多一个。
我更正了
如果这是一次性练习，而且你有20个值，方法可能仍然是适当的，因为您可以离开宏运行并执行其他任务6,12,24或48分钟。如果您有多个值，并且要重复运行宏，则不采用此方法。
Ok, I´ve found similar questions but none of them solve this problem so here I go:
I´ve a list of individuals (col. "A"), and each of them has a value assigned for a determined parameter (col. "B"). I´ve some target parameter values and I want to know which combinations of individuals sum up "x" for that parameter value.
Let´s take an example:
Col. A Col. B
M 10
N -5
O -8
P 0.87
Q 9
- Target for Parameter("X"): 9-10
- Solution:
S1= Q+P -> 9.87
S2= Q -> 9
As you can see just by inspection, the only ways to do this is taking Q, or Q+P. But in my case, I´ve between 10-15 subjects each time, and doing the work by inspection is not easy at all.
I would want to generate a chart with all the possible values (being able to know which subjects are generating the value), or just a way to know the "y" closest combinations.
The original question involved 5 values for which a brute force approach was acceptable. The number of values was then increased and more sophisticated approaches were required. I suggest you start with this answer, which describes the brute force approach, followed by:
First answer
You need to break your requirement into a number of simple steps. It may be possible to combine two or more steps but complex steps take more time to write and more time to debug. Start simple. Once your code is working, you can worry about making faster or prettier or whatever is necessary. Too many programmers forget that fast, pretty code that does not work is useless.
I created a worksheet "Source" and populated it with values so:
I need to put the minimum and maximum values somewhere so I placed them on this worksheet.
I created a worksheet "Result". The output from the macro below is:
You do not list "10 M" as a solution. I do not know if this is an oversight or if your interpretation of range "9-10" is different from mine. Change the line If ValueMin <= ValueCrnt And ValueMax >= ValueCrnt Then if necessary.
I notice that my columns are not in the same sequence as yours. This is an easy change which I leave for you as an exercise.
There are three major steps in my solution.
Step 1
On my worksheet the relevant data is on rows 2 to 6. You indicate you will want to add further values. The start row is fixed so I have defined it using a constant:
Const RowSrcDataFirst As Long = 2
The value of RowSrcDataLast, the last row containing data, is determined by code.
Step 2
Although your objective is to process keys and values, you are interested in rows at this stage. For example:
- Is the value on row 2 within the required range?
- Is the sum of the values on rows 2 and 3 within the required range?
- Is the sum of the values on rows 2, 4 and 6 within the required range?
If the answer to any of these questions is "Yes", then create an expression from the keys.
You need the row numbers to get at the keys and values.
My macro fills the array SrcRows with the values 2 to RowSrcDataLast. It then calls a subroutine GenerateCombinations. I use variations of this subroutine for any problem of this type.
GenerateCombinations takes two arrays as parameters, Value and Result, plus a separator characters. On return, Result returns an array containing a concatenated string for every combination of the values in Value. If Value contains the values: 2, 3, 4, 5 and 6, the returned strings are:
Inx Combination
0
1 2
2 3
3 2|3
4 4
5 2|4
6 3|4
7 2|3|4
8 5
9 2|5
10 3|5
11 2|3|5
12 4|5
13 2|4|5
14 3|4|5
15 2|3|4|5
16 6
17 2|6
18 3|6
19 2|3|6
20 4|6
21 2|4|6
22 3|4|6
23 2|3|4|6
24 5|6
25 2|5|6
26 3|5|6
27 2|3|5|6
28 4|5|6
29 2|4|5|6
30 3|4|5|6
31 2|3|4|5|6
I think there are enough comments within the routine to explain how it generates this result.
Step 3
The macro loops down the returned array, splitting the returned string and accessing each row of that combination.
I hope that all makes sense. Come back with questions if necessary but the more you can decipher my code by yourself, the faster you will understand it.
Code
Option Explicit
Sub Control()
' Using constants instead of literals has the following effects:
' 1) It takes longer to type the code. For example:
' ValueMin = .Range(CellSrcMin).Value takes longer to type than
' ValueMin = .Range("C3").Value
' 2) The code is self-documenting. The purpose of ".Range(CellSrcMin).Value"
' is a lot more obvious than the purpose of ".Range("C3").Value". This may
' not matter today but, when you return to this macro in 6 months, self-
' documenting code is a real help.
' 3) If a cell address, a column code or a worksheet name changes, all you
' have to do is change the value of the constant and the code is fixed.
' Scanning you code for every occurance of a literal and deciding if it
' one that needs to change is a nightmare.
Const CellSrcMin As String = "C3"
Const CellSrcMax As String = "D3"
Const ColRsltValue As String = "A"
Const ColRsltKeyExpn As String = "B"
Const ColSrcKey As String = "A"
Const ColSrcValue As String = "B"
Const RowSrcDataFirst As Long = 2
Const WshtNameRslt As String = "Result"
Const WshtNameSrc As String = "Source"
Dim InxResultCrnt As Long
Dim InxResultPartCrnt As Long
Dim InxSrcRowCrnt As Long
Dim RowRsltCrnt As Long
Dim RowSrcCrnt As Long
Dim RowSrcDataLast As Long
Dim SrcRows() As String
Dim Result() As String
Dim ResultPart() As String
Dim ValueCrnt As Double
Dim ValueKey As String
Dim ValueMin As Double
Dim ValueMax As Double
' Find last row containing data
With Worksheets(WshtNameSrc)
RowSrcDataLast = .Cells(Rows.Count, ColSrcKey).End(xlUp).Row
End With
' Rows RowSrcDataFirst to RowSrcDataLast contain data.
' Size SrcRows so it can hold each value in this range
ReDim SrcRows(1 To RowSrcDataLast - RowSrcDataFirst + 1)
' Fill SrcRows with every row that contains data
RowSrcCrnt = RowSrcDataFirst
For InxSrcRowCrnt = 1 To UBound(SrcRows)
SrcRows(InxSrcRowCrnt) = RowSrcCrnt
RowSrcCrnt = RowSrcCrnt + 1
Next
' Generate every possible combination
Call GenerateCombinations(SrcRows, Result, "|")
' Output contents of Result to Immediate Window.
' Delete or comment out once you fully understand what
' GenerateCombinations is doing.
Debug.Print "Inx Combination"
For InxResultCrnt = 0 To UBound(Result)
Debug.Print Right(" " & InxResultCrnt, 3) & " " & Result(InxResultCrnt)
Next
' Get the minimum and maximum values
With Worksheets(WshtNameSrc)
ValueMin = .Range(CellSrcMin).Value
ValueMax = .Range(CellSrcMax).Value
End With
' Initialise result worksheet
With Worksheets(WshtNameRslt)
.Cells.EntireRow.Delete
With .Range("A1")
.Value = "Total"
.HorizontalAlignment = xlRight
End With
.Range("B1").Value = "Key Expn"
.Range("A1:B1").Font.Bold = True
' This value will be overwritten if any combination gives an acceptable value
.Range("A2").Value = "No combination gives a value in the range " & _
ValueMin & " to " & ValueMax
End With
RowRsltCrnt = 2
With Worksheets(WshtNameSrc)
' Get the minimum and maximum values
ValueMin = .Range(CellSrcMin).Value
ValueMax = .Range(CellSrcMax).Value
' For each result except first which is no row selected
For InxResultCrnt = 1 To UBound(Result)
ResultPart = Split(Result(InxResultCrnt), "|")
ValueCrnt = 0#
For InxResultPartCrnt = 0 To UBound(ResultPart)
ValueCrnt = ValueCrnt + .Cells(ResultPart(InxResultPartCrnt), ColSrcValue).Value
Next
If ValueMin <= ValueCrnt And ValueMax >= ValueCrnt Then
' This value within acceptable range
Worksheets(WshtNameRslt).Cells(RowRsltCrnt, ColRsltValue) = ValueCrnt
' Create key string
ValueKey = .Cells(ResultPart(0), ColSrcKey).Value
For InxResultPartCrnt = 1 To UBound(ResultPart)
ValueKey = ValueKey & "+" & .Cells(ResultPart(InxResultPartCrnt), ColSrcKey).Value
Next
Worksheets(WshtNameRslt).Cells(RowRsltCrnt, ColRsltKeyExpn) = ValueKey
RowRsltCrnt = RowRsltCrnt + 1
End If
Next
End With
End Sub
Sub GenerateCombinations(ByRef Value() As String, ByRef Result() As String, _
ByVal Sep As String)
' * On entry, array Value contains values. For example: A, B, C.
' * On exit, array Result contains one entry for every possible combination
' of values from Value. For example, if Sep = "|":
' 0) ' None of the values is an allowable combination
' 1) A
' 2) B
' 3) A|B
' 4) C
' 5) A|C
' 6) B|C
' 7) A|B|C
' * The bounds of Value can be any valid range,
' * The lower bound of Result will be zero. The upper bound of Result
' will be as required to hold all combinations.
Dim InxRMax As Integer ' Maximum used entry in array Result
Dim InxVRCrnt As Integer ' Working index into arrays Value and InxResultCrnt
Dim NumValues As Long ' Number of values
Dim InxResultCrnt() As Long ' Entry = 1 if corresponding value
' selected for this combination
NumValues = UBound(Value) - LBound(Value) + 1
ReDim Result(0 To 2 ^ NumValues - 1) ' One entry per combination
ReDim InxResultCrnt(LBound(Value) To UBound(Value)) ' One entry per value
' Initialise InxResultCrnt for no values selected
For InxVRCrnt = LBound(Value) To UBound(Value)
InxResultCrnt(InxVRCrnt) = 0
Next
InxRMax = -1
Do While True
' Output current result
InxRMax = InxRMax + 1
If InxRMax > UBound(Result) Then
' There are no more combinations to output
Exit Sub
End If
Result(InxRMax) = ""
For InxVRCrnt = LBound(Value) To UBound(Value)
If InxResultCrnt(InxVRCrnt) = 1 Then
' This value selected
If Result(InxRMax) <> "" Then
Result(InxRMax) = Result(InxRMax) & Sep
End If
Result(InxRMax) = Result(InxRMax) & Value(InxVRCrnt)
End If
Next
' Treat InxResultCrnt as a little endian binary number
' and step its value by 1. Ignore overflow.
' Values will be:
' 000000000
' 100000000
' 010000000
' 110000000
' 001000000
' etc
For InxVRCrnt = LBound(Value) To UBound(Value)
If InxResultCrnt(InxVRCrnt) = 0 Then
InxResultCrnt(InxVRCrnt) = 1
Exit For
Else
InxResultCrnt(InxVRCrnt) = 0
End If
Next
Loop
End Sub
New section
Nuclearman's explanation of the overflow is partially correct. Data type Integer always specifies a 16-bit signed integer. This is not dependent on the Excel version. Arrays sizes are not a limiting issue.
The macro GenerateCombinations was originally written years ago when data type Integer was appropriate. I failed to notice these definitions:
Dim InxRMax As Integer ' Maximum used entry in array Result
Dim InxVRCrnt As Integer ' Working index into arrays Value and InxResultCrnt
They should be replaced by:
Dim InxRMax As Long ' Maximum used entry in array Result
Dim InxVRCrnt As Long ' Working index into arrays Value and InxResultCrnt
Data type Long specifies a 32-bit signed integer which will fix the immediate problem.
Note: you should never use data type Integer on 32 or 64-bit computers because 16-bit integer require special (slow) processing.
The table below reveals the hidden problem:
Duration
Number of Number of of macro
Keys/Values combinations in seconds
5 32 0.17
10 1,024 0.24
15 32,768 3.86
16 65,536 8.02
17 131,072 16.95
18 262,144 33.04
19 524,288 67.82
20 1,048,576 142.82
25 33,554,432
30 1,073,741,824
31 2,147,483,648
The number of combinations of N values is 2^N. My macro is generating every possible combination and storing it as a string in an array. With 15 values that array has 32,768 entries which is one more than the maximum value for a 16-bit signed integer.
I corrected the data type of InxRMax to Long and timed the macro for different numbers of values. You can see that the duration approximately doubles for each extra value. I am not willing to test the maco with 21 or more values. The macro would have failed again if I had tried 31 values and waited until it had finished.
If this is a one-off exercise and you have than 20 values, this approach may still be appropriate because you can leave the macro running and do something else for 6, 12, 24 or 48 minutes. This approach will not be appropriate if you have more than a few values and you want to run the macro repeatedly fot different sets of values.
这篇关于组合在excel中：找到每一个可能的组合的每一个可能的总和的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
