EXCEL VBA 取决于单元格值的可能组合
EXCEL VBA FOR POSSIBLE COMBINATIONS DEPENDING ON CELLS VALUES
我是 excel vba 新手，无法解决我根据单元格中的值（或数据）构建组合的问题。我的问题定义如下：
组合源单元格
X Col-B Col-C Col-D
1 MinAdt MaxAdt Total
2 1 2 4
<hr/>
X Col-B&C Col-D&E Col-F&G Col-H&I Col-J&K Col-L&M Col-N&O
5 Infant(M) Child-1(M) Child-2(M) Child-3(M) Child-4(M) Child-5(M) Child-6(M)
6 From|To From|To From|To From|To From|To From|To From|To
7 0|02,99 03|06,99 07|12,99
(M)表示合并单元格，“|”引用单独的单元格（未合并）
"H" 列后的 table 中未定义年龄（空白），但可能会根据酒店
B2、C2、D2 的值可能会根据房间大小而变化，并且 "Total Pax" 可能会根据 child 房间的容量增加 5、6 或更多（这不是总数单元格 B2 和 C2）。
在 children 的单元格中给出了 7 个年龄（在 table 时不超过 6 个 chd）。所以所有可能的组合应该如下所示：
X Col-B Col-C
10 1ADT+1CHD (0-02,99)
11 1ADT+1CHD (03-06,99)
12 1ADT+1CHD (07-12,99)
13 1ADT+2CHD (0-02,99)
14 1ADT+2CHD (0-02,99)(03-06,99)
15 1ADT+2CHD (0-02,99)(07-12,99)
16 1ADT+2CHD (03-06,99)
17 1ADT+2CHD (03-06,99)(07-12,99)
18 1ADT+2CHD (07-12,99)
19 1ADT+3CHD (0-02,99)
20 1ADT+3CHD (0-02,99)(0-02,99)(03-06,99)
21 1ADT+3CHD (0-02,99)(03-06,99)(03-06,99)
22 1ADT+3CHD (0-02,99)(0-02,99)(07-12,99)
23 1ADT+3CHD (0-02,99)(07-12,99)(07-12,99)
24 1ADT+3CHD (0-02,99)(03-06,99)(07-12,99)
25 1ADT+3CHD (03-06,99)
26 1ADT+3CHD (03-06,99)(03-06,99)(07-12,99)
27 1ADT+3CHD (03-06,99)(07-12,99)(07-12,99)
28 1ADT+3CHD (07-12,99)
29 2ADT+1CHD (0-02,99)
30 2ADT+1CHD (03-06,99)
31 2ADT+1CHD (07-12,99)
32 2ADT+2CHD (0-02,99)
33 2ADT+2CHD (0-02,99)(03-06,99)
34 2ADT+2CHD (0-02,99)(07-12,99)
35 2ADT+2CHD (03-06,99)
36 2ADT+2CHD (03-06,99)(07-12,99)
37 2ADT+2CHD (07-12,99)
38 3ADT+1CHD (0-02,99)
39 3ADT+1CHD (03-06,99)
40 3ADT+1CHD (07-12,99)
从组合table可以看出，包括children在内，总数不能超过4。所以房间的最大容量被计算为1+3或2+2或3+1。相同组合的重复也被省略。
提前致谢。
根据您最新的解释，并将您的示例结果与我的进行比较，我相信我现在明白您的要求了。
您将参数放在工作表上并将结果输出到同一个工作表。我不想将生成代码绑定到特定样式的输入或输出，并编写了一个子例程：
Sub Generate(ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _
ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _
ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _
ByVal MaxChildrenPerRange As Long, ByRef Results() As String)
在我的测试例程中，我这样调用这个例程：
Call Generate(1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
和
Call Generate(0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
第一个调用符合您的示例。第二个测试并演示例程中的其他功能。对于第一次调用，参数映射到您的工作表：
MinAdultsPerRoom Load from B2
MaxAdultsPerRoom Load from C2
MinChildrenPerRoom See below
MaxChildrenPerRoom See below
MaxPersonsPerRoom Load from D2
ChildAgeRanges() Load from row 7
MaxChildrenPerRange See below
Results() Write to columns B and C starting from row 10
您没有与标记为“见下文”的参数等效的参数。在我看来，您的输出需要这些参数。例如，在您的示例中，每个房间至少有 1 child，但我看不到指定此值的位置。我现在不确定这些参数是否必要，但我决定不删除它们以防它们有用。第二次调用演示了这些参数的用法。
数组 Results 包含准备输出到工作表的组合，采用您示例中使用的样式。
我的测试例程使用以下调用来输出参数和结果：
Call OutParametersAndResults("Sheet2", ColOut, 1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
和
Call OutParametersAndResults("Sheet2", ColOut, 0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
我的输出与您的相似但不完全相同，因为我的输出是为了方便测试而构建的。通过将宏Test和OutParametersAndResults替换为您自己的代码，您可以根据需要加载参数和输出结果。宏 Generate 不需要更改。
本节简要说明宏 Generate 的工作原理。但是，我怀疑您会发现将我的代码复制到新工作簿 运行 Test 并研究输出会更容易。
我有两个数组。第一个 Working 是二维的，用于存储生成过程中接受的组合。第二个 WorkingCrnt 是一维的，用于生成可能的组合。
WorkingCrnt的排列是：
Number Number of range Number of range ...
of adults 1 children 2 children ...
您数据的第 20 行：1ADT+3CHD (0-02,99)(0-02,99)(03-06,99) 将在 WorkingCrnt 中表示为：
1 2 1 0
即作为1个成人+2个range-1children+1个range-2children+0个range-3children.
WorkingCrnt的元素取值范围为：
Min adults Min children Min children
To to to
Max adults Max children Max children
秘诀在于系统地生成可能的组合，拒绝未通过验证检查的个别组合，并在未来任何组合都不可能有效时停止生成组合。例如，之后：
1 2 1 0
下一个可能的组合是：
1 2 2 0
这个组合将被拒绝，因为它有五个人，超过了房间的最大人数。这意味着没有必要测试任何：
1 2 3 0
1 2 1 1
1 2 1 2
1 2 1 3
不生成这些组合并且不测试它们可以大大减少生成过程的持续时间。
我希望下面的代码包含足够的注释来解释它的作用和方式。诊断输出到即时 Window 以帮助测试和理解例程。
Option Explicit
Sub Test()
Dim ColOut As Long
Dim ChildAgeRanges() As String
Dim Results() As String
ColOut = 1
ReDim ChildAgeRanges(1 To 3)
ChildAgeRanges(1) = "(0-02,99)"
ChildAgeRanges(2) = "(03-06,99)"
ChildAgeRanges(3) = "(07-12,99)"
Call Generate(1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
Call OutParametersAndResults("Sheet2", ColOut, 1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
ReDim ChildAgeRanges(1 To 4)
ChildAgeRanges(1) = "(0-2)"
ChildAgeRanges(2) = "(3-6)"
ChildAgeRanges(3) = "(7-12)"
ChildAgeRanges(4) = "(13-15)"
Call Generate(0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
Call OutParametersAndResults("Sheet2", ColOut, 0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
End Sub
Sub Generate(ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _
ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _
ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _
ByVal MaxChildrenPerRange As Long, ByRef Results() As String)
' On return Result contains one row per combination of people that
' can occupy a hotel room.
' MinAdultsPerRoom The minimum number of adults in a room
' MaxAdultsPerRoom The maximum number of adults in a room. If all
' occupants of a room can be adults, the calling
' routine should set this to MaxPersonsPerRoom.
' MinChildrenPerRoom The minimum number of children in a room
' MaxChildrenPerRoom The maximum number of children in a room. If all
' occupants of a room can be children, the calling
' routine should set this to MaxPersonsPerRoom.
' MaxPersonsPerRoom The maximum number of persons (adults or children)
' in a room.
' ChildAgeRanges A string array listing all the age ranges for
' children. These should be of the form "(n-m)" but the
' routine does not check this.
' MaxChildrenPerRange The maximum number of children that can be within the
' same age range. If there is no maximum, the calling
' routine should set this to MaxChildrenPerRoom.
' Result The string array in which the possible combinations
' are returned. On return, it will have two columns
' and one row per combination. The columns will
' contain:
' 1 A string of the form nADT+mCHD where n is the
' number of adults and m the number of children.
' 2 A string of the form "(n-m)" or "(n-m)(p-q)"
' or similar. The substrings "(n-m)", "(p-q)" and
' so on are taken unchecked from ChildAgeRanges.
' Check for parameter values that will break code
' Execution will stop with one of these statements highlighted if a
' parameter value or combination of parameter values is forbidden.
Debug.Assert MaxAdultsPerRoom + MaxChildrenPerRoom > 0
Debug.Assert MinAdultsPerRoom <= MaxAdultsPerRoom
Debug.Assert MinChildrenPerRoom <= MaxChildrenPerRoom
Debug.Assert MaxPersonsPerRoom >= MinAdultsPerRoom + MinChildrenPerRoom
Debug.Assert MaxAdultsPerRoom <= MaxPersonsPerRoom
Debug.Assert MaxChildrenPerRoom <= MaxPersonsPerRoom
Dim ColWorkCrnt As Long
Dim ColWorkMax As Long
Dim FirstCombinationForNewNumOfAdults As Boolean
Dim InvalidCombination As Boolean
Dim InxAdultCrnt As Long
Dim InxChildCrnt As Long
Dim InxRangeCrnt As Long
Dim NumChildrenInRange As Long
Dim NumChildrenInRoom As Long
Dim NumRanges As Long
Dim RowWorkCrnt As Long
Dim RowWorkMax As Long
Dim StepBack As Boolean
Dim Working() As Long
Dim WorkingSingle() As Long
NumRanges = UBound(ChildAgeRanges) - LBound(ChildAgeRanges) + 1
' Working is the array in which the details of possible combinations are
' accumulated in a format convenient for processing.
' The columns are:
' 1 Number of adults for this combination
' 2 Number of children within first age range
' 3 Number of children within second age range
' : : : : :
' It is theoretically possible to calculate the number of combinations for
' a given set of parameters. However, this would be a difficult calculation
' and the benefits are not obvious. With a maximum of 6 per room and 5
' different age ranges and no restriction of age mix, there are only 46,656
' combination for which the memory requirements are less than 750,000 bytes.
' So the array is dimensioned to hold the maximum number of combinations
ColWorkMax = 1 + NumRanges
ReDim Working(1 To ColWorkMax, 1 To MaxPersonsPerRoom ^ (1 + NumRanges))
RowWorkMax = 0 ' The last used row
ReDim WorkingSingle(1 To ColWorkMax) ' Used to build one row of Working
' Initialise WorkingSingle with:
' Element 1 = Minimum number of adults per room
' Element Max = 1
' Other elements = 0
WorkingSingle(1) = MinAdultsPerRoom
WorkingSingle(ColWorkMax) = MinChildrenPerRoom
If MinAdultsPerRoom + MinChildrenPerRoom = 0 Then
' Both adults and children are optional but must have
' at least one person in the initial combination.
If MaxChildrenPerRoom > 0 Then
' Can have a child in room
WorkingSingle(ColWorkMax) = 1
Else
WorkingSingle(1) = 1
End If
End If
FirstCombinationForNewNumOfAdults = True
For ColWorkCrnt = 2 To ColWorkMax - 1
WorkingSingle(ColWorkCrnt) = 0
Next
' Output headers for diagnostics
For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)
Debug.Print " R" & InxRangeCrnt & " = " & ChildAgeRanges(InxRangeCrnt)
Next
Debug.Print Space(9) & " A";
For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)
Debug.Print " R" & InxRangeCrnt;
Next
Debug.Print
Do While True
' Is WorkingSingle a valid combination?
InvalidCombination = False
NumChildrenInRoom = 0
For ColWorkCrnt = 2 To ColWorkMax
NumChildrenInRoom = NumChildrenInRoom + WorkingSingle(ColWorkCrnt)
Next
If NumChildrenInRoom > MaxChildrenPerRoom Then
InvalidCombination = True
ElseIf NumChildrenInRoom + WorkingSingle(1) > MaxPersonsPerRoom Then
InvalidCombination = True
End If
If Not InvalidCombination Then
' Save accepted combination
RowWorkMax = RowWorkMax + 1
For ColWorkCrnt = 1 To ColWorkMax
Working(ColWorkCrnt, RowWorkMax) = WorkingSingle(ColWorkCrnt)
Next
' Output accepted combination
Debug.Print "Accepted ";
For ColWorkCrnt = 1 To ColWorkMax
Debug.Print Right(" " & WorkingSingle(ColWorkCrnt), 2) & " ";
Next
Debug.Print
Else
' Output rejected combination
Debug.Print "Rejected ";
For ColWorkCrnt = 1 To ColWorkMax
Debug.Print Right(" " & WorkingSingle(ColWorkCrnt), 2) & " ";
Next
Debug.Print
End If
' Find last non-zero column in WorkingSingle
For ColWorkCrnt = ColWorkMax To 1 Step -1
If WorkingSingle(ColWorkCrnt) > 0 Then
Exit For
End If
Next
If NumChildrenInRoom + WorkingSingle(1) >= MaxPersonsPerRoom Then
' Either this combination or the next would exceed the room limit
If ColWorkCrnt = 1 Then
' All combinations have been generated
Exit Do
Else
' Can do nothing more with this column. Try previous
WorkingSingle(ColWorkCrnt) = 0
ColWorkCrnt = ColWorkCrnt - 1
StepBack = True
End If
Else
' Continue with current and following columns
StepBack = False
End If
Do While True
' Loop until new combination generated or no new combination is possible
' FirstCombinationForNewNumOfAdults ensure that if zero children are
' permitted, so first non-zero column is 1, the number of adults is
' not immediately stepped.
If ColWorkCrnt = 1 And Not FirstCombinationForNewNumOfAdults Then
' Adult column
WorkingSingle(ColWorkCrnt) = WorkingSingle(ColWorkCrnt) + 1
WorkingSingle(ColWorkMax) = MinChildrenPerRoom
FirstCombinationForNewNumOfAdults = True
'Check for all combinations having been generated outside this loop
Exit Do
Else
' Child column
FirstCombinationForNewNumOfAdults = False
If WorkingSingle(ColWorkCrnt) >= MaxChildrenPerRange Then
' This column cannot be increased
If StepBack Or ColWorkCrnt = ColWorkMax Then
' All combinations of following columns have been
' considered or there are no following columns.
' Can do nothing more with this column. Try previous
WorkingSingle(ColWorkCrnt) = 0
ColWorkCrnt = ColWorkCrnt - 1
StepBack = True
Else
' Not all possible combinations of following columns
' have been considered. Start with last
WorkingSingle(ColWorkMax) = 1
Exit Do
End If
Else
' This column can be increased
If StepBack Or ColWorkCrnt = ColWorkMax Then
' All possible values for following columns have been
' considered or there are no following columns
' Step this column which is not at maximum
WorkingSingle(ColWorkCrnt) = WorkingSingle(ColWorkCrnt) + 1
Else
' Not all possible combinations of following columns
' have been considered
WorkingSingle(ColWorkMax) = 1
Exit Do
End If
Exit Do
End If
End If
Loop ' until next combination generated
If WorkingSingle(1) > MaxAdultsPerRoom Then
' All combinations have been generated
Exit Do
End If
Loop ' until all combinations generated
' Working contains all acceptable combination
' Generate Results from Working
' Note this is sized ready to be written to a worksheet
' with the rows as the first dimension.
ReDim Results(1 To RowWorkMax, 1 To 2)
For RowWorkCrnt = 1 To RowWorkMax
' Calculate number of children and number of different age ranges
NumChildrenInRoom = 0
For ColWorkCrnt = 2 To ColWorkMax
If Working(ColWorkCrnt, RowWorkCrnt) <> 0 Then
NumChildrenInRoom = NumChildrenInRoom + Working(ColWorkCrnt, RowWorkCrnt)
End If
Next
' Note row number in Working and Results are the same
Results(RowWorkCrnt, 1) = Working(1, RowWorkCrnt) & "ADT"
Results(RowWorkCrnt, 2) = ""
If NumChildrenInRoom > 0 Then
Results(RowWorkCrnt, 1) = Results(RowWorkCrnt, 1) & "+" & NumChildrenInRoom & "CHD"
For ColWorkCrnt = 2 To ColWorkMax
NumChildrenInRange = Working(ColWorkCrnt, RowWorkCrnt)
If NumChildrenInRange > 0 Then
If NumChildrenInRange = NumChildrenInRoom Then
' All children in combination have same age range
Results(RowWorkCrnt, 2) = ChildAgeRanges(ColWorkCrnt - 2 + LBound(ChildAgeRanges))
Else
' Children are of different age ranges
Do While NumChildrenInRange > 0
Results(RowWorkCrnt, 2) = Results(RowWorkCrnt, 2) & _
ChildAgeRanges(ColWorkCrnt - 2 + LBound(ChildAgeRanges))
NumChildrenInRange = NumChildrenInRange - 1
Loop
End If
End If
Next
End If
Next
End Sub
Sub OutParametersAndResults(ByVal WshtName As String, ByRef ColOut As Long, _
ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _
ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _
ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _
ByVal MaxChildrenPerRange As Long, ByRef Results() As String)
' Output the parameters and results for a call of Generate.
' WshtName The name of the worksheet to which the parameters and results
' are to be output.
' ColOut The rows used by the routine are fixed with output of
' parameters starting on row 3. The value of ColOut determines
' the first of the three columns used. At the end of routine
' ColOut is stepped by 4 so if the routine is called again,
' output will be further to the right.
' Other parameters Copies of the parameters for and results from macro Generate.
Dim InxRangeCrnt As Long
Dim Rng As Range
Dim RowCrnt As Long
With Worksheets(WshtName)
.Cells(3, ColOut + 1).Value = "Minimum"
.Cells(3, ColOut + 2).Value = "Maximum"
.Cells(4, ColOut).Value = "Adults per room"
.Cells(4, ColOut + 1).Value = MinAdultsPerRoom
.Cells(4, ColOut + 2).Value = MaxAdultsPerRoom
.Cells(5, ColOut).Value = "Children per room"
.Cells(5, ColOut + 1).Value = MinChildrenPerRoom
.Cells(5, ColOut + 2).Value = MaxChildrenPerRoom
.Cells(6, ColOut).Value = "Persons per room"
.Cells(6, ColOut + 2).Value = MaxPersonsPerRoom
.Cells(7, ColOut).Value = "Children per range"
.Cells(7, ColOut + 2).Value = MaxChildrenPerRange
.Cells(8, ColOut).Value = "Age ranges"
RowCrnt = 8
For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)
.Cells(RowCrnt, ColOut + 1).Value = ChildAgeRanges(InxRangeCrnt)
RowCrnt = RowCrnt + 1
Next
RowCrnt = RowCrnt + 1
Set Rng = Range(.Cells(RowCrnt, ColOut), .Cells(RowCrnt + UBound(Results) - 1, ColOut + 1))
Rng.Value = Results
Rng.Sort Key1:=.Cells(RowCrnt, ColOut), Order1:=xlAscending, _
Key2:=.Cells(RowCrnt, ColOut + 1), Order2:=xlAscending, _
Header:=xlNo
Rng.EntireColumn.AutoFit
End With
' Prepare for possible further output
ColOut = ColOut + 4
End Sub
我是 excel vba 新手，无法解决我根据单元格中的值（或数据）构建组合的问题。我的问题定义如下：
组合源单元格
X Col-B Col-C Col-D
1 MinAdt MaxAdt Total
2 1 2 4
<hr/>
X Col-B&C Col-D&E Col-F&G Col-H&I Col-J&K Col-L&M Col-N&O
5 Infant(M) Child-1(M) Child-2(M) Child-3(M) Child-4(M) Child-5(M) Child-6(M)
6 From|To From|To From|To From|To From|To From|To From|To
7 0|02,99 03|06,99 07|12,99
(M)表示合并单元格，“|”引用单独的单元格（未合并）
"H" 列后的 table 中未定义年龄（空白），但可能会根据酒店
发生
B2、C2、D2 的值可能会根据房间大小而变化，并且 "Total Pax" 可能会根据 child 房间的容量增加 5、6 或更多（这不是总数单元格 B2 和 C2）。
在 children 的单元格中给出了 7 个年龄（在 table 时不超过 6 个 chd）。所以所有可能的组合应该如下所示：
X Col-B Col-C
10 1ADT+1CHD (0-02,99)
11 1ADT+1CHD (03-06,99)
12 1ADT+1CHD (07-12,99)
13 1ADT+2CHD (0-02,99)
14 1ADT+2CHD (0-02,99)(03-06,99)
15 1ADT+2CHD (0-02,99)(07-12,99)
16 1ADT+2CHD (03-06,99)
17 1ADT+2CHD (03-06,99)(07-12,99)
18 1ADT+2CHD (07-12,99)
19 1ADT+3CHD (0-02,99)
20 1ADT+3CHD (0-02,99)(0-02,99)(03-06,99)
21 1ADT+3CHD (0-02,99)(03-06,99)(03-06,99)
22 1ADT+3CHD (0-02,99)(0-02,99)(07-12,99)
23 1ADT+3CHD (0-02,99)(07-12,99)(07-12,99)
24 1ADT+3CHD (0-02,99)(03-06,99)(07-12,99)
25 1ADT+3CHD (03-06,99)
26 1ADT+3CHD (03-06,99)(03-06,99)(07-12,99)
27 1ADT+3CHD (03-06,99)(07-12,99)(07-12,99)
28 1ADT+3CHD (07-12,99)
29 2ADT+1CHD (0-02,99)
30 2ADT+1CHD (03-06,99)
31 2ADT+1CHD (07-12,99)
32 2ADT+2CHD (0-02,99)
33 2ADT+2CHD (0-02,99)(03-06,99)
34 2ADT+2CHD (0-02,99)(07-12,99)
35 2ADT+2CHD (03-06,99)
36 2ADT+2CHD (03-06,99)(07-12,99)
37 2ADT+2CHD (07-12,99)
38 3ADT+1CHD (0-02,99)
39 3ADT+1CHD (03-06,99)
40 3ADT+1CHD (07-12,99)
从组合table可以看出，包括children在内，总数不能超过4。所以房间的最大容量被计算为1+3或2+2或3+1。相同组合的重复也被省略。
提前致谢。
根据您最新的解释，并将您的示例结果与我的进行比较，我相信我现在明白您的要求了。
您将参数放在工作表上并将结果输出到同一个工作表。我不想将生成代码绑定到特定样式的输入或输出，并编写了一个子例程：
Sub Generate(ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _
ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _
ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _
ByVal MaxChildrenPerRange As Long, ByRef Results() As String)
在我的测试例程中，我这样调用这个例程：
Call Generate(1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
和
Call Generate(0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
第一个调用符合您的示例。第二个测试并演示例程中的其他功能。对于第一次调用，参数映射到您的工作表：
MinAdultsPerRoom Load from B2
MaxAdultsPerRoom Load from C2
MinChildrenPerRoom See below
MaxChildrenPerRoom See below
MaxPersonsPerRoom Load from D2
ChildAgeRanges() Load from row 7
MaxChildrenPerRange See below
Results() Write to columns B and C starting from row 10
您没有与标记为“见下文”的参数等效的参数。在我看来，您的输出需要这些参数。例如，在您的示例中，每个房间至少有 1 child，但我看不到指定此值的位置。我现在不确定这些参数是否必要，但我决定不删除它们以防它们有用。第二次调用演示了这些参数的用法。
数组 Results 包含准备输出到工作表的组合，采用您示例中使用的样式。
我的测试例程使用以下调用来输出参数和结果：
Call OutParametersAndResults("Sheet2", ColOut, 1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
和
Call OutParametersAndResults("Sheet2", ColOut, 0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
我的输出与您的相似但不完全相同，因为我的输出是为了方便测试而构建的。通过将宏Test和OutParametersAndResults替换为您自己的代码，您可以根据需要加载参数和输出结果。宏 Generate 不需要更改。
本节简要说明宏 Generate 的工作原理。但是，我怀疑您会发现将我的代码复制到新工作簿 运行 Test 并研究输出会更容易。
我有两个数组。第一个 Working 是二维的，用于存储生成过程中接受的组合。第二个 WorkingCrnt 是一维的，用于生成可能的组合。
WorkingCrnt的排列是：
Number Number of range Number of range ...
of adults 1 children 2 children ...
您数据的第 20 行：1ADT+3CHD (0-02,99)(0-02,99)(03-06,99) 将在 WorkingCrnt 中表示为：
1 2 1 0
即作为1个成人+2个range-1children+1个range-2children+0个range-3children.
WorkingCrnt的元素取值范围为：
Min adults Min children Min children
To to to
Max adults Max children Max children
秘诀在于系统地生成可能的组合，拒绝未通过验证检查的个别组合，并在未来任何组合都不可能有效时停止生成组合。例如，之后：
1 2 1 0
下一个可能的组合是：
1 2 2 0
这个组合将被拒绝，因为它有五个人，超过了房间的最大人数。这意味着没有必要测试任何：
1 2 3 0
1 2 1 1
1 2 1 2
1 2 1 3
不生成这些组合并且不测试它们可以大大减少生成过程的持续时间。
我希望下面的代码包含足够的注释来解释它的作用和方式。诊断输出到即时 Window 以帮助测试和理解例程。
Option Explicit
Sub Test()
Dim ColOut As Long
Dim ChildAgeRanges() As String
Dim Results() As String
ColOut = 1
ReDim ChildAgeRanges(1 To 3)
ChildAgeRanges(1) = "(0-02,99)"
ChildAgeRanges(2) = "(03-06,99)"
ChildAgeRanges(3) = "(07-12,99)"
Call Generate(1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
Call OutParametersAndResults("Sheet2", ColOut, 1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)
ReDim ChildAgeRanges(1 To 4)
ChildAgeRanges(1) = "(0-2)"
ChildAgeRanges(2) = "(3-6)"
ChildAgeRanges(3) = "(7-12)"
ChildAgeRanges(4) = "(13-15)"
Call Generate(0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
Call OutParametersAndResults("Sheet2", ColOut, 0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)
End Sub
Sub Generate(ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _
ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _
ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _
ByVal MaxChildrenPerRange As Long, ByRef Results() As String)
' On return Result contains one row per combination of people that
' can occupy a hotel room.
' MinAdultsPerRoom The minimum number of adults in a room
' MaxAdultsPerRoom The maximum number of adults in a room. If all
' occupants of a room can be adults, the calling
' routine should set this to MaxPersonsPerRoom.
' MinChildrenPerRoom The minimum number of children in a room
' MaxChildrenPerRoom The maximum number of children in a room. If all
' occupants of a room can be children, the calling
' routine should set this to MaxPersonsPerRoom.
' MaxPersonsPerRoom The maximum number of persons (adults or children)
' in a room.
' ChildAgeRanges A string array listing all the age ranges for
' children. These should be of the form "(n-m)" but the
' routine does not check this.
' MaxChildrenPerRange The maximum number of children that can be within the
' same age range. If there is no maximum, the calling
' routine should set this to MaxChildrenPerRoom.
' Result The string array in which the possible combinations
' are returned. On return, it will have two columns
' and one row per combination. The columns will
' contain:
' 1 A string of the form nADT+mCHD where n is the
' number of adults and m the number of children.
' 2 A string of the form "(n-m)" or "(n-m)(p-q)"
' or similar. The substrings "(n-m)", "(p-q)" and
' so on are taken unchecked from ChildAgeRanges.
' Check for parameter values that will break code
' Execution will stop with one of these statements highlighted if a
' parameter value or combination of parameter values is forbidden.
Debug.Assert MaxAdultsPerRoom + MaxChildrenPerRoom > 0
Debug.Assert MinAdultsPerRoom <= MaxAdultsPerRoom
Debug.Assert MinChildrenPerRoom <= MaxChildrenPerRoom
Debug.Assert MaxPersonsPerRoom >= MinAdultsPerRoom + MinChildrenPerRoom
Debug.Assert MaxAdultsPerRoom <= MaxPersonsPerRoom
Debug.Assert MaxChildrenPerRoom <= MaxPersonsPerRoom
Dim ColWorkCrnt As Long
Dim ColWorkMax As Long
Dim FirstCombinationForNewNumOfAdults As Boolean
Dim InvalidCombination As Boolean
Dim InxAdultCrnt As Long
Dim InxChildCrnt As Long
Dim InxRangeCrnt As Long
Dim NumChildrenInRange As Long
Dim NumChildrenInRoom As Long
Dim NumRanges As Long
Dim RowWorkCrnt As Long
Dim RowWorkMax As Long
Dim StepBack As Boolean
Dim Working() As Long
Dim WorkingSingle() As Long
NumRanges = UBound(ChildAgeRanges) - LBound(ChildAgeRanges) + 1
' Working is the array in which the details of possible combinations are
' accumulated in a format convenient for processing.
' The columns are:
' 1 Number of adults for this combination
' 2 Number of children within first age range
' 3 Number of children within second age range
' : : : : :
' It is theoretically possible to calculate the number of combinations for
' a given set of parameters. However, this would be a difficult calculation
' and the benefits are not obvious. With a maximum of 6 per room and 5
' different age ranges and no restriction of age mix, there are only 46,656
' combination for which the memory requirements are less than 750,000 bytes.
' So the array is dimensioned to hold the maximum number of combinations
ColWorkMax = 1 + NumRanges
ReDim Working(1 To ColWorkMax, 1 To MaxPersonsPerRoom ^ (1 + NumRanges))
RowWorkMax = 0 ' The last used row
ReDim WorkingSingle(1 To ColWorkMax) ' Used to build one row of Working
' Initialise WorkingSingle with:
' Element 1 = Minimum number of adults per room
' Element Max = 1
' Other elements = 0
WorkingSingle(1) = MinAdultsPerRoom
WorkingSingle(ColWorkMax) = MinChildrenPerRoom
If MinAdultsPerRoom + MinChildrenPerRoom = 0 Then
' Both adults and children are optional but must have
' at least one person in the initial combination.
If MaxChildrenPerRoom > 0 Then
' Can have a child in room
WorkingSingle(ColWorkMax) = 1
Else
WorkingSingle(1) = 1
End If
End If
FirstCombinationForNewNumOfAdults = True
For ColWorkCrnt = 2 To ColWorkMax - 1
WorkingSingle(ColWorkCrnt) = 0
Next
' Output headers for diagnostics
For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)
Debug.Print " R" & InxRangeCrnt & " = " & ChildAgeRanges(InxRangeCrnt)
Next
Debug.Print Space(9) & " A";
For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)
Debug.Print " R" & InxRangeCrnt;
Next
Debug.Print
Do While True
' Is WorkingSingle a valid combination?
InvalidCombination = False
NumChildrenInRoom = 0
For ColWorkCrnt = 2 To ColWorkMax
NumChildrenInRoom = NumChildrenInRoom + WorkingSingle(ColWorkCrnt)
Next
If NumChildrenInRoom > MaxChildrenPerRoom Then
InvalidCombination = True
ElseIf NumChildrenInRoom + WorkingSingle(1) > MaxPersonsPerRoom Then
InvalidCombination = True
End If
If Not InvalidCombination Then
' Save accepted combination
RowWorkMax = RowWorkMax + 1
For ColWorkCrnt = 1 To ColWorkMax
Working(ColWorkCrnt, RowWorkMax) = WorkingSingle(ColWorkCrnt)
Next
' Output accepted combination
Debug.Print "Accepted ";
For ColWorkCrnt = 1 To ColWorkMax
Debug.Print Right(" " & WorkingSingle(ColWorkCrnt), 2) & " ";
Next
Debug.Print
Else
' Output rejected combination
Debug.Print "Rejected ";
For ColWorkCrnt = 1 To ColWorkMax
Debug.Print Right(" " & WorkingSingle(ColWorkCrnt), 2) & " ";
Next
Debug.Print
End If
' Find last non-zero column in WorkingSingle
For ColWorkCrnt = ColWorkMax To 1 Step -1
If WorkingSingle(ColWorkCrnt) > 0 Then
Exit For
End If
Next
If NumChildrenInRoom + WorkingSingle(1) >= MaxPersonsPerRoom Then
' Either this combination or the next would exceed the room limit
If ColWorkCrnt = 1 Then
' All combinations have been generated
Exit Do
Else
' Can do nothing more with this column. Try previous
WorkingSingle(ColWorkCrnt) = 0
ColWorkCrnt = ColWorkCrnt - 1
StepBack = True
End If
Else
' Continue with current and following columns
StepBack = False
End If
Do While True
' Loop until new combination generated or no new combination is possible
' FirstCombinationForNewNumOfAdults ensure that if zero children are
' permitted, so first non-zero column is 1, the number of adults is
' not immediately stepped.
If ColWorkCrnt = 1 And Not FirstCombinationForNewNumOfAdults Then
' Adult column
WorkingSingle(ColWorkCrnt) = WorkingSingle(ColWorkCrnt) + 1
WorkingSingle(ColWorkMax) = MinChildrenPerRoom
FirstCombinationForNewNumOfAdults = True
'Check for all combinations having been generated outside this loop
Exit Do
Else
' Child column
FirstCombinationForNewNumOfAdults = False
If WorkingSingle(ColWorkCrnt) >= MaxChildrenPerRange Then
' This column cannot be increased
If StepBack Or ColWorkCrnt = ColWorkMax Then
' All combinations of following columns have been
' considered or there are no following columns.
' Can do nothing more with this column. Try previous
WorkingSingle(ColWorkCrnt) = 0
ColWorkCrnt = ColWorkCrnt - 1
StepBack = True
Else
' Not all possible combinations of following columns
' have been considered. Start with last
WorkingSingle(ColWorkMax) = 1
Exit Do
End If
Else
' This column can be increased
If StepBack Or ColWorkCrnt = ColWorkMax Then
' All possible values for following columns have been
' considered or there are no following columns
' Step this column which is not at maximum
WorkingSingle(ColWorkCrnt) = WorkingSingle(ColWorkCrnt) + 1
Else
' Not all possible combinations of following columns
' have been considered
WorkingSingle(ColWorkMax) = 1
Exit Do
End If
Exit Do
End If
End If
Loop ' until next combination generated
If WorkingSingle(1) > MaxAdultsPerRoom Then
' All combinations have been generated
Exit Do
End If
Loop ' until all combinations generated
' Working contains all acceptable combination
' Generate Results from Working
' Note this is sized ready to be written to a worksheet
' with the rows as the first dimension.
ReDim Results(1 To RowWorkMax, 1 To 2)
For RowWorkCrnt = 1 To RowWorkMax
' Calculate number of children and number of different age ranges
NumChildrenInRoom = 0
For ColWorkCrnt = 2 To ColWorkMax
If Working(ColWorkCrnt, RowWorkCrnt) <> 0 Then
NumChildrenInRoom = NumChildrenInRoom + Working(ColWorkCrnt, RowWorkCrnt)
End If
Next
' Note row number in Working and Results are the same
Results(RowWorkCrnt, 1) = Working(1, RowWorkCrnt) & "ADT"
Results(RowWorkCrnt, 2) = ""
If NumChildrenInRoom > 0 Then
Results(RowWorkCrnt, 1) = Results(RowWorkCrnt, 1) & "+" & NumChildrenInRoom & "CHD"
For ColWorkCrnt = 2 To ColWorkMax
NumChildrenInRange = Working(ColWorkCrnt, RowWorkCrnt)
If NumChildrenInRange > 0 Then
If NumChildrenInRange = NumChildrenInRoom Then
' All children in combination have same age range
Results(RowWorkCrnt, 2) = ChildAgeRanges(ColWorkCrnt - 2 + LBound(ChildAgeRanges))
Else
' Children are of different age ranges
Do While NumChildrenInRange > 0
Results(RowWorkCrnt, 2) = Results(RowWorkCrnt, 2) & _
ChildAgeRanges(ColWorkCrnt - 2 + LBound(ChildAgeRanges))
NumChildrenInRange = NumChildrenInRange - 1
Loop
End If
End If
Next
End If
Next
End Sub
Sub OutParametersAndResults(ByVal WshtName As String, ByRef ColOut As Long, _
ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _
ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _
ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _
ByVal MaxChildrenPerRange As Long, ByRef Results() As String)
' Output the parameters and results for a call of Generate.
' WshtName The name of the worksheet to which the parameters and results
' are to be output.
' ColOut The rows used by the routine are fixed with output of
' parameters starting on row 3. The value of ColOut determines
' the first of the three columns used. At the end of routine
' ColOut is stepped by 4 so if the routine is called again,
' output will be further to the right.
' Other parameters Copies of the parameters for and results from macro Generate.
Dim InxRangeCrnt As Long
Dim Rng As Range
Dim RowCrnt As Long
With Worksheets(WshtName)
.Cells(3, ColOut + 1).Value = "Minimum"
.Cells(3, ColOut + 2).Value = "Maximum"
.Cells(4, ColOut).Value = "Adults per room"
.Cells(4, ColOut + 1).Value = MinAdultsPerRoom
.Cells(4, ColOut + 2).Value = MaxAdultsPerRoom
.Cells(5, ColOut).Value = "Children per room"
.Cells(5, ColOut + 1).Value = MinChildrenPerRoom
.Cells(5, ColOut + 2).Value = MaxChildrenPerRoom
.Cells(6, ColOut).Value = "Persons per room"
.Cells(6, ColOut + 2).Value = MaxPersonsPerRoom
.Cells(7, ColOut).Value = "Children per range"
.Cells(7, ColOut + 2).Value = MaxChildrenPerRange
.Cells(8, ColOut).Value = "Age ranges"
RowCrnt = 8
For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)
.Cells(RowCrnt, ColOut + 1).Value = ChildAgeRanges(InxRangeCrnt)
RowCrnt = RowCrnt + 1
Next
RowCrnt = RowCrnt + 1
Set Rng = Range(.Cells(RowCrnt, ColOut), .Cells(RowCrnt + UBound(Results) - 1, ColOut + 1))
Rng.Value = Results
Rng.Sort Key1:=.Cells(RowCrnt, ColOut), Order1:=xlAscending, _
Key2:=.Cells(RowCrnt, ColOut + 1), Order2:=xlAscending, _
Header:=xlNo
Rng.EntireColumn.AutoFit
End With
' Prepare for possible further output
ColOut = ColOut + 4
End Sub