vba excel中的组合数学：找到每个可能组合的所有可能总和
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/26539996/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Combinatorics in excel: Find every possible sum of every possible combination
提问by Luis
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.
我有一个个人列表（列“A”），每个人都有一个为确定的参数分配的值（列“B”）。我有一些目标参数值，我想知道哪些个体组合为该参数值总结了“x”。
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.
正如您通过检查所看到的，唯一的方法是取 Q 或 Q+P。但就我而言，我每次都在10-15个科目之间，通过检查来完成工作一点也不容易。
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.
我想生成一个包含所有可能值的图表（能够知道哪些主题正在生成值），或者只是一种了解“y”最接近组合的方法。
回答by Tony Dallimore
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:
最初的问题涉及 5 个可以接受蛮力方法的值。然后增加了值的数量，需要更复杂的方法。我建议你从这个答案开始，它描述了蛮力方法，然后是：
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 Thenif necessary.
您没有列出“10 M”作为解决方案。我不知道这是否是疏忽，或者您对“9-10”范围的解释是否与我的不同。If ValueMin <= ValueCrnt And ValueMax >= ValueCrnt Then如有必要，更改线路。
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
第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:
在我的工作表上，相关数据位于第 2 行到第 6 行。您表示要添加更多值。起始行是固定的，所以我使用常量定义了它：
Const RowSrcDataFirst As Long = 2
The value of RowSrcDataLast, the last row containing data, is determined by code.
的值RowSrcDataLast，包含数据的最后一行，由代码确定。
Step 2
第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?
- 第 2 行的值是否在要求的范围内？
- 第 2 行和第 3 行的值的总和是否在要求的范围内？
- 第 2、4 和 6 行的值的总和是否在要求的范围内？
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 SrcRowswith the values 2 to RowSrcDataLast. It then calls a subroutine GenerateCombinations. I use variations of this subroutine for any problem of this type.
我的宏SrcRows用值 2 到填充数组RowSrcDataLast。然后它调用一个子程序GenerateCombinations。对于任何此类问题，我都会使用此子程序的变体。
GenerateCombinationstakes two arrays as parameters, Valueand Result, plus a separator characters. On return, Resultreturns 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:
GenerateCombinations将两个数组作为参数，Value和Result，加上一个分隔符。返回时，Result为 Value 中的每个值组合返回一个包含串联字符串的数组。如果 Value 包含值：2、3、4、5 和 6，则返回的字符串为：
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
第 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.
核能人对溢出的解释是部分正确的。数据类型 Integer 总是指定一个 16 位有符号整数。这不依赖于 Excel 版本。数组大小不是限制问题。
The macro GenerateCombinationswas originally written years ago when data type Integer was appropriate. I failed to notice these definitions:
该宏GenerateCombinations最初是在几年前编写的，当时数据类型为 Integer。我没有注意到这些定义：
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.
数据类型 Long 指定了一个 32 位有符号整数，它将解决当前的问题。
Note: you should never use data type Integer on 32 or 64-bit computers because 16-bit integer require special (slow) processing.
注意：永远不要在 32 位或 64 位计算机上使用数据类型 Integer，因为 16 位整数需要特殊（慢）处理。
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.
N 个值的组合数为 2^N。我的宏正在生成所有可能的组合并将其作为字符串存储在数组中。该数组有 15 个值，有 32,768 个条目，比 16 位有符号整数的最大值多 1。
I corrected the data type of InxRMaxto 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.
我将数据类型更正InxRMax为 Long 并为不同数量的值对宏进行计时。您可以看到，每个额外值的持续时间大约加倍。我不愿意用 21 个或更多值来测试 maco。如果我尝试了 31 个值并等到它完成，宏就会再次失败。
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.
如果这是一次性练习并且您有 20 个以上的值，那么这种方法可能仍然适用，因为您可以让宏运行并在 6、12、24 或 48 分钟内执行其他操作。如果您有多个值并且想要针对不同的值集重复运行宏，则此方法将不合适。
回答by Tony Dallimore
Second answer
第二个答案
My first answer is, I believe, about as simple a solution as is possible:
我相信，我的第一个答案是一个尽可能简单的解决方案：
- The steps are completely separate making then easier to code and understand.
- Most of the work is within a routine I have used before and will no doubt use again.
- Has an acceptable duration for small numbers of items.
- Is not affected by having both positive and negative values.
- 这些步骤是完全独立的，因此更容易编码和理解。
- 大部分工作都在我以前使用过的例程中，毫无疑问会再次使用。
- 对于少量项目具有可接受的持续时间。
- 不受正值和负值的影响。
This answer uses a different approach. The steps are not separate, making them more complicated, and I doubt I have a future use for this code. The approach is affected by having negative numbers but I have coded around that issue. The big advantage is that the duration is substantially reduced.
这个答案使用了不同的方法。这些步骤不是分开的，使它们变得更加复杂，我怀疑我将来是否可以使用此代码。该方法受到负数的影响，但我已经围绕该问题进行了编码。最大的优点是持续时间大大减少。
I do not believe this is an implementation of the algorithm referenced by Nuclearman. Apparently that algorithm requires all numbers to be positive and involves a sort per element; neither of which is true for my approach.
我不相信这是Nuclearman 引用的算法的实现。显然，该算法要求所有数字都是正数，并且涉及每个元素的排序；对于我的方法，这两种方法都不是真的。
The duration of my macro is dependent on the range of values and I lack the mathematical skill to determine an expected upper value for the duration. The table below gives indicative durations:
我的宏的持续时间取决于值的范围，我缺乏确定持续时间的预期上限值的数学技能。下表给出了指示性持续时间：
Duration of Duration of Number of
Number of Number of approach 1 approach 2 combinations
Keys/Values combinations in seconds in seconds tested
1 2
2 4
3 8
4 16
5 32 0.17 0.20 29
6 64
7 128
8 256
9 512
10 1,024 0.24 0.27 100
11 2,048
12 4,096
13 8,192
14 16,384
15 32,768 3.86 0.41 10,021
16 65,536 8.02 0.64 18,586
17 131,072 16.95 0.70 21,483
18 262,144 33.04 0.76 24,492
19 524,288 67.82 0.83 28,603
20 1,048,576 142.82 0.99 34,364
21 2,097,152
22 4,194,304
23 8,388,608
24 16,777,216
25 33,554,432
26 67,108,864 8.97 315,766
The duration of approach 1 doubles with each extra item because it tests every possible combination. Approach 2 is more complicated and is slower with smaller number of items but by only testing a small proportion of the possible combinations it is the quicker approach with larger number of items. I have used the same data for the Approach 1 and 2 tests so I believe this gives an indication of durations you might expect.
方法 1 的持续时间随着每个额外项目的增加而加倍，因为它测试了所有可能的组合。方法 2 更复杂，项目数量较少时速度较慢，但仅测试一小部分可能的组合，它是项目数量较多的更快方法。我在方法 1 和方法 2 测试中使用了相同的数据，所以我相信这可以表明您可能期望的持续时间。
The first step in approach 2 is to sort the KeyValue table into ascending order by value.
方法 2 的第一步是按值对 KeyValue 表进行升序排序。
The next step is to import the KeyValue table from the worksheet to an array. This could have been done with Approach 1 but that approach was all about simplicity while Approach 2 is about doing anything to reduce the duration.
下一步是将 KeyValue 表从工作表导入到数组中。这本来可以用方法 1 来完成，但这种方法完全是为了简单，而方法 2 是为了减少持续时间。
Suppose a combination is a selection from Value(1) to Value(N). If adding Value(N+1) to the combination takes the total over the maximum then adding any later value would also take the total over the maximum because all later values are larger than Value(N+1). Therefore, any addition to this combination will take it over the maximum total and no extension need be considered.
假设一个组合是从 Value(1) 到 Value(N) 的选择。如果将 Value(N+1) 添加到组合中使总数超过最大值，那么添加任何后面的值也会使总数超过最大值，因为所有后面的值都大于 Value(N+1)。因此，对该组合的任何添加都将超过最大总数，无需考虑扩展。
I have been much more careful with the documentation within the Approach 2 macros. I believe I have full explained the approach and its implementation. However, come back with questions if necessary.
我对方法 2 宏中的文档更加小心。我相信我已经充分解释了该方法及其实施。但是，如有必要，请返回问题。
Option Explicit
' * I have a system for allocating names to my constants and variables.
' I can look at macros I wrote years ago and immediately know the
' purpose of the variables. This is a real help if I need to enhance
' an old macro.
' * If you do not like my system, develop your own.
' * My names are a sequence of words each of which reduces the scope
' of the variable.
' * Typically, the first word identified the purpose:
' Inx index into a 1D array
' Col a column of a worksheet or a 2D array
' Row a row of a worksheet or a 2D array
' Wsht something to do with a worksheet
' * If I have more than worksheet, I will have a keyword to identify
' which worksheet a variable is used for:
' ColSrc a column of the source worksheet
' RowRslt a row of a results worksheet
' ColKV a column of the KeyValue array
' Although most constants are only used by one routine, some are used by
' more than one. I have defined all as global so all constants are together.
' ==========================================================================
' * Changes values if the minimum and maximum values are moved.
' * The code assumes both values are in the Source worksheet.
Const CellSrcMin As String = "C3"
Const CellSrcMax As String = "D3"
' * The leftmost column will always be 1 no matter what
' columns the KeyValue table occupies in the worksheet
' * Reverse values if the columns are swapped
Const ColKVKey As Long = 1
Const ColKVValue As Long = 2
' * Reverse values if the columns are swapped
Const ColRsltValue As String = "A"
Const ColRsltExpnKey As String = "B"
Const ColRsltExpnValue As String = "C"
' * Change both of these constants if the KeyValue table
' does not start in column A of the worksheet
Const ColSrcKVFirst As String = "A"
Const ColSrcKVLast As String = "B"
' * Change both of these constants if the KeyValue table
' does not start in column A of the worksheet
' * Reverse values if the columns are swapped
Const ColSrcKVKey As String = "A"
Const ColSrcKVValue As String = "B"
' Increase value if a second or third header row is added
' Reduce value to 1 if there is no header row
Const RowSrcDataFirst As Long = 2
' Change values to match worksheet names
Const WshtRsltName As String = "Result"
Const WshSrcName As String = "Source"
' Variables used by more than one routine
' =======================================
' The KeyValue table will be loaded from the source worksheet to this
' variant as a 2D array
Dim KeyValue As Variant
' Row in results worksheet to which the next result will be written
Dim RowRsltNext As Long
Sub Control2()
' If one of the tests of the last entry in the pending arrays
' indicate that entry should be deleted, set to True.
Dim DeleteEntry As Boolean
' The current last used entry in the pending arrays
Dim InxPendingCrntMax As Long
' Number of combinations tested
Dim NumTested As Long
' * The Pending arrays hold information about combinations that are pending;
' that is, combinations that have not been accepted as having an in-range
' total and have not been rejected as having an above maximum total.
' * The value of an entry in PendingWhichKeys might be "++-+". This means
' that this combination contains the first, second and fourth values but not
' the third. The corresponding entry in PendingTotal will contain the total
' of the first, second and fourth values.
Dim PendingWhichKeys() As String
Dim PendingTotal() As Double
' * Rows within KeyValue.
' * RowKVFirst is the control variable for the outer For-Loop. A value of N
' means this repeat considers combinations that start with the Nth value.
' * RowKVCrnt is used in the inner Do-Loop. It is set to the number of the
' next row to be considered for addition to a combination.
Dim RowKVFirst As Long
Dim RowKVCrnt As Long
' The last row of the KeyValue table within the source worksheet
Dim RowSrcDataLast As Long
' Used to calculate the duration of a run. Set by Timer to the number of
' seconds since midnight. The value includes fractions of a second but I
' cannot find any documentation that specifies how accurate the time is.
' I suspect it depends on the clock speed. Anyway, with OS and other
' background routines running at any time, no timings are that accurate.
Dim TimeStart As Double
' The minimum and maximum values are copied from the
' source worksheet to these variables.
Dim TotalMax As Double
Dim TotalMin As Double
TimeStart = Timer
With Worksheets(WshSrcName)
' Find last row in KeyValue table
RowSrcDataLast = .Cells(Rows.Count, ColSrcKVKey).End(xlUp).Row
' Sort KeyValue table within worksheet by value
.Range(.Cells(RowSrcDataFirst, ColSrcKVKey), _
.Cells(RowSrcDataLast, ColSrcKVValue)) _
.Sort Key1:=.Range(ColSrcKVValue & RowSrcDataFirst), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' KeyValue is of data type Variant (meaning it can hold anything).
' This statement loads all the data from a range and places it in KeyValue
' as a 2D array. The first dimension will be for rows and the second for
' columns. Both lower bounds will be 1 regardless of where the range was
' located.
KeyValue = .Range(.Cells(RowSrcDataFirst, ColSrcKVFirst), _
.Cells(RowSrcDataLast, ColSrcKVLast)).Value
' Get the minimum and maximum required values
TotalMin = .Range(CellSrcMin).Value
TotalMax = .Range(CellSrcMax).Value
End With
' Initialise result worksheet
With Worksheets(WshtRsltName)
.Cells.EntireRow.Delete
With .Range("A1")
.Value = "Total"
.HorizontalAlignment = xlRight
End With
.Range("B1").Value = "Key Expn"
.Range("C1").Value = "Value Expn"
.Range("A1:C1").Font.Bold = True
' This value will be overwritten if any combination gives an acceptable value
.Range("A2").Value = "No combination gives a total in the range " & _
TotalMin & " to " & TotalMax
End With
RowRsltNext = 2
' The maximum pending entries is the number of rows in the KeyValue table
ReDim PendingWhichKeys(1 To UBound(KeyValue, 1))
ReDim PendingTotal(1 To UBound(KeyValue, 1))
NumTested = 0
' Each repeat of this loop considers the combinations that
' start with the KeyValue from RowKVFirst.
For RowKVFirst = 1 To UBound(KeyValue, 1)
If KeyValue(RowKVFirst, ColKVValue) > TotalMax Then
' The value of the first entry is above the maximum acceptable value.
' Any further values will be even larger so there are no more combinations
' that could be acceptable
Exit For
End If
' Create entries in the pending arrays for the shortest combination
' being considered during this repeat of the outer loop.
PendingWhichKeys(1) = "+"
PendingTotal(1) = KeyValue(RowKVFirst, ColKVValue)
InxPendingCrntMax = 1 ' The last currently used entry
NumTested = NumTested + 1
Do While InxPendingCrntMax > 0
' Examine last entry in pending arrays:
' * if total is within range, add entry to results worksheet
' * if adding the value of the next KeyValue would cause the total
' to exceed the maximum, delete entry from pending arrays
' * if the last row of the KeyValue table has been considered for
' inclusion in the combination, delete entry from pending arrays
' * if the entry is not to be deleted:
' * create new entry in pending arrays.
' * copy the previous last entry to this new entry but with an
' extra "-" at the end of the PendingWhichKeys entry
' * Add "+" to end of PendingWhichKeys entry and add appropriate
' value to PendingTotal entry
If PendingTotal(InxPendingCrntMax) >= TotalMin And _
PendingTotal(InxPendingCrntMax) <= TotalMax Then
' This is an acceptable value
If Right(PendingWhichKeys(InxPendingCrntMax), 1) = "+" Then
' This combination has not been output before
Call OutputResult(RowKVFirst, PendingWhichKeys(InxPendingCrntMax), _
PendingTotal(InxPendingCrntMax))
End If
End If
DeleteEntry = False
' Identify next row of KeyValue that could be added to combination
RowKVCrnt = RowKVFirst + Len(PendingWhichKeys(InxPendingCrntMax))
If RowKVCrnt > UBound(KeyValue, 1) Then
' All rows have been considered for addition to this combination
DeleteEntry = True
ElseIf PendingTotal(InxPendingCrntMax) + KeyValue(RowKVCrnt, ColKVValue) _
> TotalMax Then
' Adding another value to this combination would cause it to exceed
' the maximum value. Because of the sort, any other values will be
' larger than the current value so no extension to this combination
' need be considered.
DeleteEntry = True
End If
If DeleteEntry Then
' Abandon this combination
InxPendingCrntMax = InxPendingCrntMax - 1
Else
' Extend this combination
' Create new combination based on non-addition of current row
' to current combination
PendingWhichKeys(InxPendingCrntMax + 1) = _
PendingWhichKeys(InxPendingCrntMax) & "-"
PendingTotal(InxPendingCrntMax + 1) = PendingTotal(InxPendingCrntMax)
' Add current row to existing combination
PendingWhichKeys(InxPendingCrntMax) = _
PendingWhichKeys(InxPendingCrntMax) & "+"
PendingTotal(InxPendingCrntMax) = PendingTotal(InxPendingCrntMax) + _
KeyValue(RowKVCrnt, ColKVValue)
InxPendingCrntMax = InxPendingCrntMax + 1
' I consider both the new and the amended entries as new tests
NumTested = NumTested + 2
End If
Loop
Next
With Worksheets(WshtRsltName)
.Columns("A:C").AutoFit
End With
Debug.Print "Number keys " & UBound(KeyValue, 1)
Debug.Print "Number tested " & NumTested
Debug.Print "Duration: " & Format(Timer - TimeStart, "#,##0.00")
End Sub
Sub OutputResult(ByVal RowKVFirst As Long, ByVal WhichKeys As String, _
ByVal Total As Double)
' Output a result to result worksheet
' Global variables:
' * KeyValue
' * RowRsltNext
' Parameters:
' * RowKVFirst Identifies the first row in KeyValue being considered
' currently. KeyValues in rows 1 to RowKVFirst-1 are not
' within the current combination.
' * WhichKeys Identifies which KeyValues are present in the current
' combination. If the value is "++-+" then:
' * Row RowKVFirst selected
' * Row RowKVFirst+1 selected
' * Row RowKVFirst+2 not selected
' * Row RowKVFirst+3 selected
' * Row RowKVFirst+4, if present, and any following rows
' not selected
' * Total The total value of the current combination.
Dim ExpnKey As String
Dim ExpnValue As String
Dim PosWhichKeys As Long
Dim RowKVCrnt As Long
With Worksheets(WshtRsltName)
' Output total for combination
.Cells(RowRsltNext, ColRsltValue) = Total
' Create key string
' Get Key and Value from first row within combination
ExpnKey = KeyValue(RowKVFirst, ColKVKey)
ExpnValue = KeyValue(RowKVFirst, ColKVValue)
' Add keys and values from any other rows
For PosWhichKeys = 2 To Len(WhichKeys)
If Mid(WhichKeys, PosWhichKeys, 1) = "+" Then
' This rows is within combination
RowKVCrnt = RowKVFirst + PosWhichKeys - 1
ExpnKey = ExpnKey & "+" & KeyValue(RowKVCrnt, ColKVKey)
ExpnValue = ExpnValue & "+" & KeyValue(RowKVCrnt, ColKVValue)
End If
Next
.Cells(RowRsltNext, ColRsltExpnKey) = ExpnKey
.Cells(RowRsltNext, ColRsltExpnValue) = ExpnValue
RowRsltNext = RowRsltNext + 1
End With
End Sub
回答by Tony Dallimore
Code for Approach 3 - Part 1
方法 3 的代码 - 第 1 部分
The formatted code is too big for a single answer. Load part 1 followied by part 2 to their own module.
格式化的代码对于单个答案来说太大了。将第 1 部分和第 2 部分加载到它们自己的模块中。
Option Explicit
' * Address of cell holding target value
' * Changes value if the target value is moved.
' * The code assumes both values are in the Source worksheet.
Const CellSrcTgt As String = "C2"
' * Column numbers within KeyValue table once
' * The leftmost column will always be 1 no matter what
' columns the KeyValue table occupies in the worksheet
' * Reverse values if the columns are swapped
Const ColKVKey As Long = 1
Const ColKVValue As Long = 2
' * Change values if the columns are swapped.
' * Increase ColRsltMax if a new column is added
' * Providing the table in the worksheet starts in column 1, column numbers
' are the same in the array and the worksheet. If the worksheet table
' does not start in column 1, two sets of column numbers constants will be
' required and all code referencing these constants will require review.
Const ColRsltTotal As Long = 1
Const ColRsltDiffAbs As Long = 2
Const ColRsltExpnKey As Long = 3
Const ColRsltExpnValue As Long = 4
Const ColRsltMax As Long = 4
' These specify the columns with the Pending array so the code is
' self-documenting. The Pending array is internal to this set of routine
' so there is no need to change theses values
Const ColPendExpn As Long = 1
Const ColPendDiff As Long = 2
Const ColPendMax As Long = 2
' * Change both of these constants if the KeyValue table
' does not start in column A of the worksheet
Const ColSrcKVFirst As String = "A"
Const ColSrcKVLast As String = "B"
' * Change both of these constants if the KeyValue table
' does not start in column A of the worksheet
' * Reverse values if the columns are swapped
Const ColSrcKVKey As String = "A"
Const ColSrcKVValue As String = "B"
' Defines the first row within the results worksheet of the range to which
' the Results array is written. Change if the number of header rows changes.
Const RowRsltWshtDataFirst As Long = 2
' Increase value if a second or third header row is added
' Reduce value to 1 if there is no header row
Const RowSrcDataFirst As Long = 2
' Change values to match your worksheet names
Const WshtRsltName As String = "Result"
Const WshSrcName As String = "Source"
' Variables used by more than one routine
' =======================================
' The KeyValue table will be loaded from the source worksheet to this
' variant as a 2D array
Dim KeyValue As Variant
'# ' Current row number for worksheet Diag
'# Dim RowDiagCrnt As Long
Sub Control3()
' Find the combinations of items from the KeyValue tables whose total values
' are closest to the target total.
'# Dim ExpnKeyCrnt As String
'# Dim ExpnValueCrnt As String
' While duplicating a pending row, its contents are held in these variable
Dim PendExpnCrnt As String
Dim PendDiffCrnt As Long
' * The Pending array hold information about combinations that are pending;
' that is, combinations that are on target or might become on target after
' addition of further items to the combination.
' * The array is redimensioned as a 2D array with 50,000 rows and 2 columns.
' Choice of 50,000 as the number of rows is arbitrary; less might be
' adequate and more might be better.
' * Typically with 2D arrays the first dimension is for columns and the
' second for rows so the number of rows can be increased or decreased with
' "ReDim Preserve". Arrays that are read from or are written to worksheets
' must have the columns and rows reversed. Pending is both written to and
' read from the worksheet Sort.
' * Column 1 holds detains of the combination as a string of the form
' "--+-+". The string has one "-" or "+" for every entry in the KeyValue
' table. If the Nth character in the string is "+", the Nth entry in the
' KeyValue table is included in the combination.
' * Column 2 holds TargetValue - TotalOfCombination.
Dim Pending() As Variant
Dim PosExpn As Long
' * Potential results are accumulated in this array.
' * The number of rows is defined by RowArrRsltsMax.
' * Initially every possible combination is added at the bottom of this
' array. Once the array is full, a new combination overwrites the
' previously stored combination with the worst total if the new combination
' has a better total. In this context, a better total is closer to the
' target total than a worse one.
' * Traditionally 2D arrays have columns as the first dimension and rows as
' the second dimension. Arrays to be written to a worksheet must have their
' dimensions the other way round. After each new result is added to this
' array, the array is written to the results rworksheet and the workbook
' saved. This slows the macro but means that if it is terminated with the
' Task Manager any results found are already saved to disc.
Dim Result() As Variant
Dim RowKVCrnt As Long ' Current row within KeyValue
Dim RowKVFirstPositive As Long ' First row within KeyValue with a +ve value
Dim RowPendCrnt As Long ' The current row in Pending
Dim RowPendCrntMax As Long ' The current last used row in Pending
Dim RowPendMaxMax As Long ' The last ever used row in Pending
' Defines the maximum number of results that will be accumulated
Const RowRsltArrMax As Long = 40
' Row in array Result to which the next result will be written providing
' RowArrRsltNext < RowArrRsltMax. Once RowArrRsltNext = RowArrRsltMax,
' any new combination overwrites an existing row.
Dim RowRsltArrNext As Long
' Control variable for For-Loop
Dim RowRsltArrCrnt As Long
' The last row of the KeyValue table within the source worksheet
Dim RowSrcDataLast As Long
' Used to calculate the duration of a run. Set by Timer to the number of
' seconds since midnight. The value includes fractions of a second but I
' cannot find any documentation that specifies how accurate the time is.
' I suspect it depends on the clock speed. Anyway, with OS and other
' background routines running at any time, no timings are that accurate.
Dim TimeStart As Double
Dim TotalNegative As Long ' The total of all negative values
Dim TotalPositive As Long ' The total of all posative values
Dim TotalTgt As Long ' The target value is copied from the source
' worksheet to this variable.
TimeStart = Timer
Application.DisplayStatusBar = True
Application.StatusBar = "No results found so far"
With Worksheets(WshSrcName)
' Find last row in KeyValue table
RowSrcDataLast = .Cells(Rows.Count, ColSrcKVKey).End(xlUp).Row
' Sort KeyValue table within worksheet by value
.Range(.Cells(RowSrcDataFirst, ColSrcKVKey), _
.Cells(RowSrcDataLast, ColSrcKVValue)) _
.Sort Key1:=.Range(ColSrcKVValue & RowSrcDataFirst), _
Order1:=xlAscending, Header:=xlNo, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
' KeyValue is of data type Variant (meaning it can hold anything).
' This statement loads all the data from a range and places it in KeyValue
' as a 2D array. The first dimension will be for rows and the second for
' columns. Both lower bounds will be 1 regardless of where the range was
' located.
KeyValue = .Range(.Cells(RowSrcDataFirst, ColSrcKVFirst), _
.Cells(RowSrcDataLast, ColSrcKVLast)).Value
' Get the target value
TotalTgt = .Range(CellSrcTgt).Value
End With
' Gather information about the KeyValue table
TotalNegative = 0
For RowKVCrnt = 1 To UBound(KeyValue, 1)
If KeyValue(RowKVCrnt, ColKVValue) >= 0 Then
' Treat a value of zero as positive. Arbitrary choice.
Exit For
End If
TotalNegative = TotalNegative + KeyValue(RowKVCrnt, ColKVValue)
Next
RowKVFirstPositive = RowKVCrnt
TotalPositive = 0
For RowKVCrnt = RowKVCrnt To UBound(KeyValue, 1)
TotalPositive = TotalPositive + KeyValue(RowKVCrnt, ColKVValue)
Next
' Initialise result worksheet
With Worksheets(WshtRsltName)
.Cells.EntireRow.Delete
With .Cells(1, ColRsltTotal)
.Value = "Total"
.HorizontalAlignment = xlRight
End With
With .Cells(1, ColRsltDiffAbs)
.Value = "Abs diff"
.HorizontalAlignment = xlRight
End With
.Cells(1, ColRsltExpnKey) = "Key Expn"
.Cells(1, ColRsltExpnValue).Value = "Value Expn"
.Range(.Cells(1, 1), .Cells(1, ColRsltMax)).Font.Bold = True
.Columns(ColRsltTotal).NumberFormat = "#,##0"
.Columns(ColRsltDiffAbs).NumberFormat = "#,##0"
' This value will be overwritten if any combination gives an acceptable value
.Range("A2").Value = "No combinations found"
End With
RowRsltArrNext = 1
' The technique used does not require large amounts of memory for pending
' combinations. During testing the maximum number of rows used was 312 with
' RowRsltArrMax = 400.
ReDim Pending(1 To 1000, 1 To ColPendMax)
ReDim Result(1 To RowRsltArrMax, 1 To ColRsltMax)
' Seed Pending with one combination for every row in the
' KeyValue table with a positive value
RowPendCrntMax = 0
For RowKVCrnt = RowKVFirstPositive To UBound(KeyValue, 1)
RowPendCrntMax = RowPendCrntMax + 1
Pending(RowPendCrntMax, ColPendExpn) = String(RowKVCrnt - 1, "-") & "+" & _
String(UBound(KeyValue, 1) - RowKVCrnt, "-")
Pending(RowPendCrntMax, ColPendDiff) = TotalTgt - KeyValue(RowKVCrnt, ColKVValue)
Next
RowPendMaxMax = RowPendCrntMax
'# RowDiagCrnt = 1
'# With Worksheets("Diag")
'# .Cells.EntireRow.Delete
'# .Cells.ClearFormats
'# .Cells(RowDiagCrnt, 1).Value = "Pending"
'# With .Cells(RowDiagCrnt, 2)
'# .Value = "Index"
'# .HorizontalAlignment = xlRight
'# End With
'# .Cells(RowDiagCrnt, 3).Value = "Expn"
'# .Cells(RowDiagCrnt, 4).Value = "Key Expn"
'# .Cells(RowDiagCrnt, 5).Value = "Value Expn"
'# With .Cells(RowDiagCrnt, 6)
'# .Value = "Total"
'# .HorizontalAlignment = xlRight
'# End With
'# .Cells(RowDiagCrnt, 7).Value = "Diff"
'# RowDiagCrnt = RowDiagCrnt + 1
'# For RowPendCrnt = 1 To RowPendCrntMax
'# .Cells(RowDiagCrnt, 2).Value = RowPendCrnt
'# With .Cells(RowDiagCrnt, 3)
'# .Value = Pending(RowPendCrnt, ColPendExpn)
'# .Font.Name = "Courier New"
'# End With
'# Call GenExpn(Pending(RowPendCrnt, ColPendExpn), ExpnKeyCrnt, ExpnValueCrnt)
'# .Cells(RowDiagCrnt, 4).Value = ExpnKeyCrnt
'# .Cells(RowDiagCrnt, 5).Value = "'" & ExpnValueCrnt
'# .Cells(RowDiagCrnt, 6).Value = "=" & ExpnValueCrnt
'# With .Cells(RowDiagCrnt, 7)
'# .Value = Format(Pending(RowPendCrnt, ColPendDiff), "#,##0")
'# End With
'# RowDiagCrnt = RowDiagCrnt + 1
'# Next
'# End With
'# RowDiagCrnt = RowDiagCrnt + 1
Do While RowPendCrntMax > 0
' This combination may be one of those with a total nearest the target
If Not OutputRslt(Pending, RowPendCrntMax, Result, RowRsltArrNext) Then
' Result is full of results with a total equal to the target total.
' No point searching any more because there is no room for more results.
Application.DisplayStatusBar = False
Debug.Print "Max Pending=" & RowPendMaxMax
Debug.Print "Duration (sss.ss): " & Format(Timer - TimeStart, "#,##0.00")
TimeStart = Timer - TimeStart ' Duration
Debug.Print "Duration (m:ss): " & Format(TimeStart \ 60, "#,##0") & ":" & Format(TimeStart Mod 60, "00")
Call MsgBox("Result worksheet is full of on-target results.", vbOKOnly)
Exit Sub
End If
PendExpnCrnt = Pending(RowPendCrntMax, ColPendExpn)
PendDiffCrnt = Pending(RowPendCrntMax, ColPendDiff)
' Remove this combination from the Pending array.
' New copies will be added if appropriate.
RowPendCrntMax = RowPendCrntMax - 1
Select Case PendDiffCrnt
Case Is < 0
' * The current total for this row is above the target.
' * Create a new combination for every negative value that can be
' added.
' * Negative values can only be added after any existing negative
' values to avoid creating multiple copies of the same combination.
' * An expression is of the form "+--+--+" with the position of each
' "+" or "-" corresponding to a row in KeyValue
For PosExpn = RowKVFirstPositive - 1 To 1 Step -1
If Mid(PendExpnCrnt, PosExpn, 1) = "-" Then
' This negative value has not been added
RowPendCrntMax = RowPendCrntMax + 1
If PosExpn = 1 Then
' "+" replaces first "-"
Pending(RowPendCrntMax, ColPendExpn) = "+" & Mid(PendExpnCrnt, 2)
Else
' "+" replaces a "-" in the middle
Pending(RowPendCrntMax, ColPendExpn) = _
Mid(PendExpnCrnt, 1, PosExpn - 1) & _
"+" & _
Mid(PendExpnCrnt, PosExpn + 1)
End If
' KeyValue(RowKVCrnt, ColKVValue) is negative so subtracting it
' will increase PendDiffCrnt.
Pending(RowPendCrntMax, ColPendDiff) = _
PendDiffCrnt - KeyValue(PosExpn, ColKVValue)
Else
' This negative value is already within the combination
' so no more negative value can be added
Exit For
End If
Next
If RowPendMaxMax < RowPendCrntMax Then
RowPendMaxMax = RowPendCrntMax
End If
Case Is >= 0
' The current total for this row is equal to or below the target
' * Create a new combination for every positive value that can be
' added.
' * Positive values can only be added after any existing positive
' values to avoid creating multiple copies of the same combination.
' * An expression is of the form "+--+--+" with the position of each
' "+" or "-" corresponding to a row in KeyValue
For PosExpn = UBound(KeyValue, 1) To RowKVFirstPositive Step -1
If Mid(PendExpnCrnt, PosExpn, 1) = "-" Then
' This positive value has not been added
RowPendCrntMax = RowPendCrntMax + 1
If PosExpn = UBound(KeyValue, 1) Then
' "+" replaces final "-"
Pending(RowPendCrntMax, ColPendExpn) = Mid(PendExpnCrnt, 1, Len(PendExpnCrnt) - 1) & "+"
Else
' "+" replaces a "-" in the middle
Pending(RowPendCrntMax, ColPendExpn) = _
Mid(PendExpnCrnt, 1, PosExpn - 1) & _
"+" & _
Mid(PendExpnCrnt, PosExpn + 1)
End If
' KeyValue(RowKVCrnt, ColKVValue) is positive so subtracting it
' will reduce PendDiffCrnt.
Pending(RowPendCrntMax, ColPendDiff) = _
PendDiffCrnt - KeyValue(PosExpn, ColKVValue)
Else
' This positive value is already within the combination
' so no more positive value can be added
Exit For
End If
Next
If RowPendMaxMax < RowPendCrntMax Then
RowPendMaxMax = RowPendCrntMax
End If
End Select
'# With Worksheets("Diag")
'#
'# .Cells(RowDiagCrnt, 1).Value = "Result"
'# With .Cells(RowDiagCrnt, 2)
'# .Value = "Index"
'# .HorizontalAlignment = xlRight
'# End With
'# With .Cells(RowDiagCrnt, 3)
'# .Value = "Total"
'# .HorizontalAlignment = xlRight
'# End With
'# With .Cells(RowDiagCrnt, 4)
'# .Value = "Abs diff"
'# .HorizontalAlignment = xlRight
'# End With
'# .Cells(RowDiagCrnt, 5).Value = "Key Expn"
'# .Cells(RowDiagCrnt, 6).Value = "Value Expn"
'# RowDiagCrnt = RowDiagCrnt + 1
'# For RowRsltArrCrnt = 1 To UBound(Result, 1)
'# If RowRsltArrCrnt < RowRsltArrNext Then
'# .Cells(RowDiagCrnt, 2).Value = RowRsltArrCrnt
'# With .Cells(RowDiagCrnt, 3)
'# .Value = Result(RowRsltArrCrnt, ColRsltTotal)
'# .NumberFormat = "#,##0"
'# End With
'# With .Cells(RowDiagCrnt, 4)
'# .Value = Result(RowRsltArrCrnt, ColRsltDiffAbs)
'# .NumberFormat = "#,##0"
'# End With
'# .Cells(RowDiagCrnt, 5).Value = Result(RowRsltArrCrnt, ColRsltExpnKey)
'# .Cells(RowDiagCrnt, 6).Value = Result(RowRsltArrCrnt, ColRsltExpnValue)
'# RowDiagCrnt = RowDiagCrnt + 1
'# End If
'# Next
'#
'# .Cells(RowDiagCrnt, 1).Value = "Pending"
'# With .Cells(RowDiagCrnt, 2)
'# .Value = "Index"
'# .HorizontalAlignment = xlRight
'# End With
'# .Cells(RowDiagCrnt, 3).Value = "Expn"
'# .Cells(RowDiagCrnt, 4).Value = "Key Expn"
'# .Cells(RowDiagCrnt, 5).Value = "Value Expn"
'# With .Cells(RowDiagCrnt, 6)
'# .Value = "Total"
'# .HorizontalAlignment = xlRight
'# End With
'# .Cells(RowDiagCrnt, 7).Value = "Diff"
'# RowDiagCrnt = RowDiagCrnt + 1
'# For RowPendCrnt = 1 To RowPendCrntMax
'# .Cells(RowDiagCrnt, 2).Value = RowPendCrnt
'# With .Cells(RowDiagCrnt, 3)
'# .Value = Pending(RowPendCrnt, ColPendExpn)
'# .Font.Name = "Courier New"
'# End With
'# Call GenExpn(Pending(RowPendCrnt, ColPendExpn), ExpnKeyCrnt, ExpnValueCrnt)
'# .Cells(RowDiagCrnt, 4).Value = ExpnKeyCrnt
'# .Cells(RowDiagCrnt, 5).Value = "'" & ExpnValueCrnt
'# .Cells(RowDiagCrnt, 6).Value = "=" & ExpnValueCrnt
'# With .Cells(RowDiagCrnt, 7)
'# .Value = Format(Pending(RowPendCrnt, ColPendDiff), "#,##0")
'# End With
'# RowDiagCrnt = RowDiagCrnt + 1
'# Next
'#
'# End With
'# RowDiagCrnt = RowDiagCrnt + 1
Loop ' While RowPendCrntMax > 0
' Will only fall out the bottom of the loop if Result array not full of on-target
' results. Final version of Result array will not have been written to worksheet
'# With Worksheets("Diag")
'# .Columns("A:" & ColNumToCode(UBound(Result, 2) + 2)).AutoFit
'# End With
With Worksheets(WshtRsltName)
.Range(.Cells(RowRsltWshtDataFirst, 1), _
.Cells(RowRsltWshtDataFirst + UBound(Result, 1) - 1, _
UBound(Result, 2))) = Result
.Columns("A:" & ColNumToCode(UBound(Result, 2))).AutoFit
End With
ThisWorkbook.Save
Application.DisplayStatusBar = False
Debug.Print "Max Pending=" & RowPendMaxMax
Debug.Print "Duration (sss.ss): " & Format(Timer - TimeStart, "#,##0.00")
TimeStart = Timer - TimeStart
Debug.Print "Duration (m:ss): " & Format(TimeStart \ 60, "#,##0") & ":" & Format(TimeStart Mod 60, "00")
End Sub
回答by Tony Dallimore
Code for Approach 3 - Part 2
方法 3 的代码 - 第 2 部分
Function ColNumToCode(ByVal ColNum As Long) As String
Dim Code As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
Code = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
Code = Chr(65 + PartNum) & Code
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = Code
End Function
Function OutputRslt(Pending, RowPendCrnt, Result, RowRsltArrNext) As Boolean
' * Output row Pending(RowPendCrnt) to array Result providing:
' * Result is not full
' * or the new row's total is closer to the target than the existing row
' whose total is furthest from the target
' * The routine returns True unless Result is full of on-target rows.
' Static variables are private to this routine but their values are preserved
' from call to call.
' DiffAbsBest is only used for the status bar message
' DiffAbsWorst allows a quick check to see if a new result is to be saved
Static DiffAbsBest As Long
Static DiffAbsWorst As Long
' Not really important. Allows the range for the results in the results
' worksheet to be calculated once rather than one per save.
Static RngRsltWsht As Range
' The row holding the current worst result
Static RowRsltArrDiffAbsWorst As Long
' It appears that if a workbook is saved too frequently, Excel can end with a
' workbook that cannot be saved either with VBA or with the keyboard. Used to
' ensure workbook is not saved more than once per minute but is saved
' regularly if changes are made.
Static RecentChange As Boolean
Static TimeLastSave As Double
' Values for the result current being saved
Dim DiffAbsCrnt As Long
Dim ExpnKeyCrnt As String
Dim ExpnValueCrnt As String
' Control variable for For-Loop
Dim RowRsltArrCrnt As Long
DiffAbsCrnt = Abs(Pending(RowPendCrnt, ColPendDiff))
If RowRsltArrNext >= UBound(Result, 1) Then
' Result already full.
If DiffAbsWorst = DiffAbsCrnt And DiffAbsCrnt = 0 Then
Debug.Assert False
' Should not be possible to get here. Result being full of
' on-target totals should have been reported when last
' non-on-target row overwritten
OutputRslt = False
If RecentChange Then
' The array Results has been changed since it was last saved to the worksheet.
RngRsltWsht.Value = Result
Worksheets(WshtRsltName).Columns("A:" & ColNumToCode(UBound(Result, 2))).AutoFit
RecentChange = False
ThisWorkbook.Save ' Might be better to remove this statement and let user save
TimeLastSave = Timer
End If
ElseIf DiffAbsWorst > DiffAbsCrnt Then
' This result to be saved
Else
' Do not keep this result
OutputRslt = True ' Result not full of on-target combinations
If TimeLastSave > Timer Then
Debug.Assert False
' Have gone over midnight. Reset TimeLastSave
TimeLastSave = Timer
End If
If TimeLastSave + 60# < Timer Then
' It has been at least one minute since the last save
RngRsltWsht.Value = Result
Worksheets(WshtRsltName).Columns("A:" & ColNumToCode(UBound(Result, 2))).AutoFit
RecentChange = False
ThisWorkbook.Save
TimeLastSave = Timer
End If
Exit Function
End If ' DiffAbsWorst < DiffAbsCrnt | DiffAbsWorst = DiffAbsCrnt
End If ' RowRsltArrNext >= UBound(Result, 1) ' Result already full.
' This result will be kept either by adding it to a partially empty
' Result array or by overwriting an existing result whose total is
' further from the target than the new result total is.
Call GenExpn(Pending(RowPendCrnt, ColPendExpn), ExpnKeyCrnt, ExpnValueCrnt)
If RowRsltArrNext > UBound(Result, 1) Then
' Result already full but new combination is better than current worst
' "=" before ExpnValueCrnt to ensure treated as a formula by Excel
Result(RowRsltArrDiffAbsWorst, ColRsltTotal) = "=" & ExpnValueCrnt
Result(RowRsltArrDiffAbsWorst, ColRsltDiffAbs) = DiffAbsCrnt
Result(RowRsltArrDiffAbsWorst, ColRsltExpnKey) = ExpnKeyCrnt
' "'" before ExpnValueCrnt to ensure not treated as a formula by Excel
Result(RowRsltArrDiffAbsWorst, ColRsltExpnValue) = "'" & ExpnValueCrnt
' New result could be new best
If DiffAbsBest > DiffAbsCrnt Then
DiffAbsBest = DiffAbsCrnt
End If
' There could be rows with a DiffAbs between the previous worst and the
' new row so search for new worst
DiffAbsWorst = DiffAbsCrnt
For RowRsltArrCrnt = 1 To UBound(Result, 1)
If Result(RowRsltArrCrnt, ColRsltDiffAbs) > DiffAbsWorst Then
RowRsltArrDiffAbsWorst = RowRsltArrCrnt
DiffAbsWorst = Result(RowRsltArrCrnt, ColRsltDiffAbs)
End If
Next
Else
' Result not full. Add new result.
If RowRsltArrNext = 1 Then
' First result being stored
DiffAbsBest = DiffAbsCrnt
DiffAbsWorst = DiffAbsCrnt
RowRsltArrDiffAbsWorst = RowRsltArrNext
With Worksheets(WshtRsltName)
Set RngRsltWsht = _
.Range(.Cells(RowRsltWshtDataFirst, 1), _
.Cells(RowRsltWshtDataFirst + UBound(Result, 1) - 1, _
UBound(Result, 2)))
End With
RecentChange = True
TimeLastSave = Timer - 61# ' Force initial save
Else
' Subsequent result being stored
If DiffAbsBest > DiffAbsCrnt Then
DiffAbsBest = DiffAbsCrnt
End If
If DiffAbsWorst < DiffAbsCrnt Then
DiffAbsWorst = DiffAbsCrnt
RowRsltArrDiffAbsWorst = RowRsltArrNext
End If
End If
' "=" before ExpnValueCrnt to ensure treated as a formula by Excel
Result(RowRsltArrNext, ColRsltTotal) = "=" & ExpnValueCrnt
Result(RowRsltArrNext, ColRsltDiffAbs) = DiffAbsCrnt
Result(RowRsltArrNext, ColRsltExpnKey) = ExpnKeyCrnt
' "'" before ExpnValueCrnt to ensure not treated as a formula by Excel
Result(RowRsltArrNext, ColRsltExpnValue) = "'" & ExpnValueCrnt
RowRsltArrNext = RowRsltArrNext + 1
End If
RecentChange = True
Application.StatusBar = "Current results; closest to furthest from target: " _
& Format(DiffAbsBest, "#,##0") & " to " _
& Format(DiffAbsWorst, "#,##0")
If RecentChange Then
' The array Results has been changed since it was last saved to the worksheet.
If TimeLastSave > Timer Then
Debug.Assert False
' Have gone over midnight. Reset TimeLastSave
TimeLastSave = Timer
ElseIf TimeLastSave + 60# < Timer Then
' It has been at least one minute since the last save
RngRsltWsht.Value = Result
Worksheets(WshtRsltName).Columns("A:" & ColNumToCode(UBound(Result, 2))).AutoFit
RecentChange = False
ThisWorkbook.Save
TimeLastSave = Timer
End If
End If
If DiffAbsWorst = 0 Then
OutputRslt = False ' Result is full of on-target rows
If RecentChange Then
' The array Results has been changed since it was last saved to the worksheet.
RngRsltWsht.Value = Result
Worksheets(WshtRsltName).Columns("A:" & ColNumToCode(UBound(Result, 2))).AutoFit
RecentChange = False
ThisWorkbook.Save ' Might be better to remove this statement and let user save
TimeLastSave = Timer
End If
Else
OutputRslt = True
End If
End Function
Sub GenExpn(ByVal PendExpn As String, ByRef RsltExpnKey As String, _
ByRef RsltExpnValue As String)
' This routine generates RsltExpnKey and RsltExpnValue from PendExpn.
' PendExpn A string of +s and -s representing a combination; for
' example "+--+--+" Each + or - represents a row in
' the KeyValue table. This combination is rows 1, 4 and 7.
' See definition of Pending array for more information
' RsltExpnKey A string of the form "A+D+G" where A, B and G represent the
' keys from the rows identified by PendExpn.
' RsltExpnValue A string of the form "A+D+G" where A, B and G represent the
' values from the rows identified by PendExpn.
Dim PosPE As Long
RsltExpnKey = ""
RsltExpnValue = ""
For PosPE = 1 To Len(PendExpn)
If Mid(PendExpn, PosPE, 1) = "+" Then
If RsltExpnKey <> "" Then
RsltExpnKey = RsltExpnKey & "+"
End If
RsltExpnKey = RsltExpnKey & KeyValue(PosPE, ColKVKey)
If KeyValue(PosPE, ColKVValue) < 0 Then
RsltExpnValue = RsltExpnValue & KeyValue(PosPE, ColKVValue)
Else
RsltExpnValue = RsltExpnValue & "+" & KeyValue(PosPE, ColKVValue)
End If
End If
Next
End Sub
回答by Tony Dallimore
Third approach
第三种方法
Approach 1 tested every possible combination. This approach was easy and simple to code and would be adequate if there were not too many items in the set. You have increased the number of items in your set so much that this approach is not viable.
方法 1 测试了每种可能的组合。这种方法易于编码，如果集合中的项目不多，就足够了。你已经增加了你的集合中的项目数量，这种方法是不可行的。
Approach 2 and 3 both identify blind alleys to reduce the number of combinations tested. Both approaches sort the set into ascending order but use different techniques for identifying blind alleys. Once I had thought of approach 3, I was confident that it would be better than approach 2. However, if there is a technique for proving approach 3 was the better approach without testing it, I am not clever enough to know it.
方法 2 和 3 都确定了死胡同以减少测试的组合数量。两种方法都将集合按升序排序，但使用不同的技术来识别死胡同。一旦我想到方法 3，我就确信它会比方法 2 更好。但是，如果有一种技术可以在不测试的情况下证明方法 3 是更好的方法，那么我还不够聪明，无法知道它。
Changes to solution 3 that are not related to the approach
解决方案 3 与方法无关的更改
This section describes changes which are better ways of parameterising the macros and better ways of presenting the results and which would have been included in solution 1 and 2 if I had thought of them earlier.
本节描述了更改参数化宏的更好方法和呈现结果的更好方法，如果我早点想到它们，这些更改将包含在解决方案 1 和 2 中。
I found having a range of targets, X ± A, where A is small awkward with smaller sets of keys. Make A too small and I would get no matches. Make A too large and I would get an over large number of matches.
我发现有一系列目标，X ± A，其中 A 小而笨拙，键组较小。使 A 太小，我将无法获得匹配项。使 A 太大，我会得到大量的匹配项。
I replaced a range with a single target and introduced a new parameter: the number of rows in the results table, RowRsltArrMax. This means that instead of having to guess a range that will give me an acceptable number of results, the routine gives me the best RowRsltArrMaxresults or stops when it has found RowRsltArrMaxon-target results.
我用单个目标替换了一个范围并引入了一个新参数：结果表中的行数RowRsltArrMax。这意味着，不必猜测一个可以给我可接受的结果数量的范围，例程会给我最好的RowRsltArrMax结果，或者在找到RowRsltArrMax目标结果时停止。
Having a fixed number of results makes it easier to manage them. Instead of writing each in-range result straight to the worksheet, I have an array ready to write to the worksheet. The first RowRsltArrMaxresults are written to the array regardless of how on or off-target they are. After that, any new result overwrites the previous worst result if it is better. Here “better” means has a total that is closer to the target.
拥有固定数量的结果可以更轻松地管理它们。我没有将每个范围内的结果直接写入工作表，而是准备好将数组写入工作表。第一个RowRsltArrMax结果被写入数组，不管它们是如何达到或偏离目标的。之后，任何新结果都会覆盖之前的最差结果（如果它更好的话）。这里的“更好”意味着总和更接近目标。
The routine now displays a message in the status bar:
该例程现在在状态栏中显示一条消息：
Current results; closest to furthest from target: N to M
When I first created the third solution, I wrote the result array to the worksheet and saved the workbook each time the result array was updated. I knew this would slow the macro but I thought having the best available results stored on disc in the event of a problem was worth the time. However, I encountered a problem. Sometimes the macro would stop on ThisWorkbook.Save. The previous version of the workbook was correctly saved on disc but the version in memory could not be saved by VBA or via the keyboard. I guessed this was something to do with how often the workbook was being saved and changed the routine so that the result array was written to the worksheet and the workbook saved once per minute if results better than those already saved are being found. This change appears to have eliminated the save problem and revealed that saving the workbook every time a new result was saved was dramatically slowing the macro as shown by these results:
当我第一次创建第三个解决方案时，我将结果数组写入工作表并在每次更新结果数组时保存工作簿。我知道这会减慢宏的速度，但我认为在出现问题时将最佳可用结果存储在磁盘上是值得的。但是，我遇到了一个问题。有时宏会停止ThisWorkbook.Save. 以前版本的工作簿已正确保存在光盘上，但无法通过 VBA 或键盘保存内存中的版本。我猜这与保存工作簿的频率和更改例程的频率有关，以便将结果数组写入工作表，如果找到比已经保存的结果更好的结果，则每分钟保存一次工作簿。此更改似乎消除了保存问题，并表明每次保存新结果时保存工作簿都会显着减慢宏，如以下结果所示：
---- Duration (m:ss)-----
RowMax Save every Save every
result minute or two
10 9:43 0:57
20 20:08 1:57
30 3:34
40 5:35
100 16:56
363 67:27
These timings were with a KeyValue table containing 43 rows, random values between ?300,000 and 1,000,000 and a target of 653,441. The values for the final row of the above table were created by setting RowRsltArrMaxso high that every combination summing to the target was found.
这些时间使用包含 43 行、介于 ?300,000 和 1,000,000 之间的随机值和 653,441 的目标的 KeyValue 表。上表最后一行的值是通过将值设置得RowRsltArrMax如此之高来创建的，以至于找到了与目标相加的每个组合。
Solution 3
解决方案3
This image shows the top of the KeyValue table and the Target value.
此图显示了 KeyValue 表的顶部和 Target 值。
This image shows the results worksheet after a run with RowRsltArrMax = 10. The formula bar shows cell A2 = cell D2 except the A2 value has = at the beginning so Excel treats it as a formula while D2 has ' at the beginning so Excel treats it as a string.
此图像显示了运行后的结果工作表RowRsltArrMax = 10。公式栏显示单元格 A2 = 单元格 D2，但 A2 值在开头有 =，因此 Excel 将其视为公式，而 D2 在开头有 '，因此 Excel 将其视为字符串。
I have not found it easy to describe the technique behind solution 3. In outline, the technique is to:
我发现描述解决方案 3 背后的技术并不容易。概括地说，该技术是：
- Seed a Pending table by creating one combination for each positive value. Seeds are not created for keys with negative values to avoid generating the same combination more than one,
- Loop repeating step 3 until either the Results table is full of on-target results or the Pending table is empty.
- Remove the bottom row from the Pending table. Consider adding it to the Results table as described in step 4. Attempt to generate more combinations from it as discussed in step 5.
- Every row removed from the Pending table is added to the Results table until it is full. Once the Results table is full, the total of each new combination is compared against the worst total so far. If the new total is better, the new row overwrites the worst row so far.
- If the total of the new combination is less than the target total, generate one new combination for each positive value that is larger than any existing positive values within the combination. If the total of the new combination is more than the target total, generate one new combination for each negative value that is larger than any existing negative values in the combinations. The “larger” restrictions avoid generating the same combination more than once.
- 通过为每个正值创建一个组合来为 Pending 表设定种子。不会为具有负值的键创建种子，以避免生成多个相同的组合，
- 循环重复步骤 3，直到结果表充满目标结果或待定表为空。
- 从 Pending 表中删除底行。考虑将其添加到结果表中，如步骤 4 中所述。尝试从中生成更多组合，如步骤 5 中所述。
- 从 Pending 表中删除的每一行都会添加到 Results 表中，直到它填满为止。结果表填满后，会将每个新组合的总数与迄今为止最差的总数进行比较。如果新的总数更好，则新行将覆盖迄今为止最差的行。
- 如果新组合的总和小于目标总和，则为每个大于组合中任何现有正值的正值生成一个新组合。如果新组合的总数大于目标总数，则为每个大于组合中任何现有负值的负值生成一个新组合。“更大”的限制避免了多次生成相同的组合。
Macro Control3contains code that will output the contents of the Pending and Results tables to worksheet “Diag” before the first loop and at the end of every loop. This code is current commented out (see statements starting ‘#) because it should only be used with small KeyValue tables. If you removing the ‘#s and run the macro with a small set and a small Results table you will generate diagnostic information in worksheet “Diag” which you can work down to see what the macro does at every step.
宏Control3包含将在第一个循环之前和每个循环结束时将 Pending 和 Results 表的内容输出到工作表“Diag”的代码。此代码当前已被注释掉（请参阅以 '# 开头的语句），因为它应该仅用于小型 KeyValue 表。如果您删除'#s 并使用一个小集合和一个小的结果表运行宏，您将在工作表“Diag”中生成诊断信息，您可以仔细查看宏在每个步骤中的作用。
The diagram below might help. For this diagram, I set RowRsltArrMax= 5and created a 6 row KeyValue table. After sorting, the KeyValue table is loaded to an array for easy access:
下图可能会有所帮助。对于这个图表，我设置RowRsltArrMax= 5并创建了一个 6 行的 KeyValue 表。排序后，将 KeyValue 表加载到一个数组中，方便访问：
Index Key Value
1 AB -205,082
2 AF -74,308
3 AC 293,704
4 AE 651,560
5 AA 761,311
6 AD 852,254
The Pending array has two columns: Expnand Diff. Expncontains strings that represent a combination while Diffcontains the difference between the total value of the combination and the Target. The Pending array is seeded with one row per positive value from the KeyValue table. The left column of the diagram below represents the seeds. The top row of each box contains a combination, the second row contains the total value of that combination and the third contains shows that total value as Target minus the total value.
Pending 数组有两列：Expn和Diff。 Expn包含表示组合的字符串，同时Diff包含组合的总值与目标之间的差值。Pending 数组以 KeyValue 表中每个正值的一行作为种子。下图的左列代表种子。每个框的顶行包含一个组合，第二行包含该组合的总值，第三行包含将总值显示为目标减去总值。
The Pending array is only seeded with positive values; this is one of three restrictions that ensure the same combination cannot be generated more than once. This particular restriction means that no combination containing only negative values can be generated. This will only be issue if the target value is negative or a low positive value. This technique could be extended to allow for such target values but I assume this is not necessary.
Pending 数组仅以正值作为种子；这是确保不能多次生成相同组合的三个限制之一。此特定限制意味着不能生成仅包含负值的组合。仅当目标值为负值或低正值时才会出现此问题。可以扩展此技术以允许此类目标值，但我认为这不是必需的。
The routine loops until the Pending array is empty. Each repeat removes the bottom row of the Pending table as a possibly satisfactory combination and then adds rows to the Pending table for any possibly better combination it can generate from the one just removed.
该例程循环直到 Pending 数组为空。每次重复都会删除 Pending 表的底行作为可能令人满意的组合，然后将行添加到 Pending 表中，以获得它可以从刚刚删除的组合中生成的任何可能更好的组合。
Consider the bottom left box in the diagram. Key AD has a value of 852,254 which is 198,813 more than the target. We can hope this is not the best combination to be found but it will be placed in the Results array until something better is found.
考虑图中左下角的方框。键 AD 的值为 852,254，比目标值多 198,813。我们希望这不是要找到的最佳组合，但它会被放置在 Results 数组中，直到找到更好的组合。
Since this combination has a total above the target, only adding negative values could lead to a better combination. Since the combination does not contain any negative values, one combination is created and added to the Pending array for each negative value. These new combinations are shown in the bottom right of the diagram.
由于此组合的总数高于目标，因此仅添加负值可能会导致更好的组合。由于该组合不包含任何负值，因此会为每个负值创建一个组合并将其添加到 Pending 数组中。这些新组合显示在图表的右下角。
Both of these new combinations will in turn be taken as the second and third entry in the Result array. However, never of these combinations can be the basis for a better combination.
这两个新组合将依次作为 Result 数组中的第二个和第三个条目。但是，这些组合中的任何一个都不能成为更好组合的基础。
AB+AD has a total 6,269 below the target so we would have to add positive values get a better combination. However, this combination already contains AD which is the lowest positive value in the KeyValue table. The second restriction to ensure only one copy of each combination is that only positive values below any existing positive values can be added. The combination AB+AA+AD will be created later by adding AD to AB+AA.
AB+AD 总共低于目标 6,269，因此我们必须添加正值以获得更好的组合。但是，此组合已包含 AD，它是 KeyValue 表中的最低正值。确保每个组合只有一个副本的第二个限制是只能添加低于任何现有正值的正值。AB+AA+AD 组合稍后将通过将 AD 添加到 AB+AA 来创建。
AF+AD has a total 124,505 above the target so we would have to add negative values get a better combination. However, this combination already contains AF which is the lowest negative value in the KeyValue table. The third restriction to ensure only one copy of each combination is that only negative values below any existing negative values can be added.
AF+AD 总共比目标高 124,505，因此我们必须添加负值以获得更好的组合。但是，此组合已包含 AF，它是 KeyValue 表中的最低负值。确保每个组合只有一个副本的第三个限制是只能添加低于任何现有负值的负值。
The next combination to be taken as a possible result is AA. The diagram shows that AF+AA and AB+AA will be generated from it. No further combination can be generated from AF+AA but AB+AA+AD can be generated from AB+AA. No further combination can be generated from AB+AA+AD.
下一个可能结果的组合是 AA。该图显示将由此生成 AF+AA 和 AB+AA。AF+AA 不能产生进一步的组合，但 AB+AA+AD 可以由 AB+AA 产生。AB+AA+AD 不能产生进一步的组合。
If you want to explore the combinations generated from AE and AC, create a KeyValue table to match mine and run the macro with the diagnostic code active.
如果您想探索从 AE 和 AC 生成的组合，请创建一个 KeyValue 表以匹配我的表并在诊断代码处于活动状态的情况下运行宏。
I cannot devise a technique that will examine fewer combinations than this one. I have more-or-less convinced myself that potentially good combinations are not ignored. Since it finds so many on-target combinations with larger sets, it may not matter if a few are overlooked.
我无法设计出一种技术来检查比这个更少的组合。我或多或少地说服自己，潜在的好组合不会被忽视。由于它发现了大量具有较大集合的目标组合，因此忽略其中一些可能无关紧要。
The secret of any such technique is to correctly identify blind alleys at the earliest possible moment. I have identified two. Perhaps you can identify one that is better than either of mine. Good luck.
任何此类技术的秘诀是尽早正确识别死胡同。我已经确定了两个。也许你可以找出一个比我任何一个都更好的。祝你好运。
I have have had to post the code for Approach 3 separately because of the character limit on the size of an answer.
由于答案大小的字符限制，我不得不单独发布方法 3 的代码。
