[ad_1]
\n<\/p>\n
With your latest explanation and comparing your example results with mine, I believe I now understand your requirement.<\/p>\n
You have the parameters placed on a worksheet and output the results to the same worksheet. I do not want to tie the generation code to a particular style of input or output and have coded a subroutine:<\/p>\n
Sub Generate(ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _\n ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _\n ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _\n ByVal MaxChildrenPerRange As Long, ByRef Results() As String)\n<\/code><\/pre>\nIn my test routine, I have called this routine so:<\/p>\n
Call Generate(1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)\n<\/code><\/pre>\nand<\/p>\n
Call Generate(0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)\n<\/code><\/pre>\nThe first call matches your example. The second tests and demonstrates other capabilities on the routine. For the first call, the parameters map to your worksheet:<\/p>\n
MinAdultsPerRoom Load from B2\nMaxAdultsPerRoom Load from C2\nMinChildrenPerRoom See below\nMaxChildrenPerRoom See below\nMaxPersonsPerRoom Load from D2\nChildAgeRanges() Load from row 7\nMaxChildrenPerRange See below\nResults() Write to columns B and C starting from row 10\n<\/code><\/pre>\nYou have no equivalent to the parameters labelled \u201cSee below.\u201d It seemed to me that these parameters were required for your output. For example, in your example, you have a minimum of 1 child per room and I could not see where this value was specified. I am not sure now that these parameters are necessary but I have decided not to remove them in case they are useful. The second call demonstrates the use of these parameters.<\/p>\n
The array Results contains the combinations ready for output to a worksheet in the style used in your example.<\/p>\n
My test routine uses the following calls to output the parameters and the results:<\/p>\n
Call OutParametersAndResults(\"Sheet2\", ColOut, 1, 3, 1, 3, 4, ChildAgeRanges, 3, Results) \n<\/code><\/pre>\nand<\/p>\n
Call OutParametersAndResults(\"Sheet2\", ColOut, 0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)\n<\/code><\/pre>\nMy output is similar to yours but not identical since my output is structured for convenient testing. By replacing macros Test<\/code> and OutParametersAndResults<\/code> with your own code, you can load parameters and output results as you wish. The macro Generate<\/code> should not require changes.<\/p>\n
\nThis section is a brief description of how macro Generate<\/code> works. However, I suspect you will find it easier to copy my code to a new workbook, run Test<\/code> and study the output. <\/p>\nI have two arrays. The first, Working<\/code> is two dimensional and is used to store accepted combinations during the generation process. The second, WorkingCrnt<\/code> is one dimensional and is used to generate possible combinations.<\/p>\nThe arrangement of WorkingCrnt<\/code> is:<\/p>\nNumber Number of range Number of range ...\nof adults 1 children 2 children ...\n<\/code><\/pre>\nRow 20 of your data: 1ADT+3CHD (0-02,99)(0-02,99)(03-06,99)<\/code> would be represented in WorkingCrnt<\/code> as:<\/p>\n 1 2 1 0\n<\/code><\/pre>\nThat is, as 1 adult + 2 range-1 children + 1 range-2 children + 0 range-3 children.<\/p>\n
The value ranges for the elements of WorkingCrnt<\/code> are:<\/p>\nMin adults Min children Min children\n To to to\nMax adults Max children Max children\n<\/code><\/pre>\nThe secret is to systematically generate possible combinations, to reject individual combinations that fail validation checks and to stop generating combinations when it is impossible for any future combination to be valid. For example, after:<\/p>\n
1 2 1 0\n<\/code><\/pre>\nthe next possible combination is:<\/p>\n
1 2 2 0\n<\/code><\/pre>\nThis combination will be rejected because it has five people which exceeds the maximum for the room. This means there is no point testing any of:<\/p>\n
1 2 3 0\n 1 2 1 1\n 1 2 1 2\n 1 2 1 3\n<\/code><\/pre>\nNot generating these combinations and not testing them can substantially reduce the duration of the generation process.<\/p>\n
\nI hope the code below contains enough comments to explain what it does and how. Diagnostics are output to the Immediate Window to help both test and understand the routine.<\/p>\n
Option Explicit\nSub Test()\n\n Dim ColOut As Long\n Dim ChildAgeRanges() As String\n Dim Results() As String\n\n ColOut = 1\n\n ReDim ChildAgeRanges(1 To 3)\n ChildAgeRanges(1) = \"(0-02,99)\"\n ChildAgeRanges(2) = \"(03-06,99)\"\n ChildAgeRanges(3) = \"(07-12,99)\"\n\n Call Generate(1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)\n\n Call OutParametersAndResults(\"Sheet2\", ColOut, 1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)\n\n ReDim ChildAgeRanges(1 To 4)\n ChildAgeRanges(1) = \"(0-2)\"\n ChildAgeRanges(2) = \"(3-6)\"\n ChildAgeRanges(3) = \"(7-12)\"\n ChildAgeRanges(4) = \"(13-15)\"\n\n Call Generate(0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)\n\n Call OutParametersAndResults(\"Sheet2\", ColOut, 0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)\n\nEnd Sub\nSub Generate(ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _\n ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _\n ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _\n ByVal MaxChildrenPerRange As Long, ByRef Results() As String)\n\n ' On return Result contains one row per combination of people that\n ' can occupy a hotel room.\n\n ' MinAdultsPerRoom The minimum number of adults in a room\n ' MaxAdultsPerRoom The maximum number of adults in a room. If all\n ' occupants of a room can be adults, the calling\n ' routine should set this to MaxPersonsPerRoom.\n ' MinChildrenPerRoom The minimum number of children in a room\n ' MaxChildrenPerRoom The maximum number of children in a room. If all\n ' occupants of a room can be children, the calling\n ' routine should set this to MaxPersonsPerRoom.\n ' MaxPersonsPerRoom The maximum number of persons (adults or children)\n ' in a room.\n ' ChildAgeRanges A string array listing all the age ranges for\n ' children. These should be of the form \"(n-m)\" but the\n ' routine does not check this.\n ' MaxChildrenPerRange The maximum number of children that can be within the\n ' same age range. If there is no maximum, the calling\n ' routine should set this to MaxChildrenPerRoom.\n ' Result The string array in which the possible combinations\n ' are returned. On return, it will have two columns\n ' and one row per combination. The columns will\n ' contain:\n ' 1 A string of the form nADT+mCHD where n is the\n ' number of adults and m the number of children.\n ' 2 A string of the form \"(n-m)\" or \"(n-m)(p-q)\"\n ' or similar. The substrings \"(n-m)\", \"(p-q)\" and\n ' so on are taken unchecked from ChildAgeRanges.\n\n ' Check for parameter values that will break code\n ' Execution will stop with one of these statements highlighted if a\n ' parameter value or combination of parameter values is forbidden.\n Debug.Assert MaxAdultsPerRoom + MaxChildrenPerRoom > 0\n Debug.Assert MinAdultsPerRoom <= MaxAdultsPerRoom\n Debug.Assert MinChildrenPerRoom <= MaxChildrenPerRoom\n Debug.Assert MaxPersonsPerRoom >= MinAdultsPerRoom + MinChildrenPerRoom\n Debug.Assert MaxAdultsPerRoom <= MaxPersonsPerRoom\n Debug.Assert MaxChildrenPerRoom <= MaxPersonsPerRoom\n\n Dim ColWorkCrnt As Long\n Dim ColWorkMax As Long\n Dim FirstCombinationForNewNumOfAdults As Boolean\n Dim InvalidCombination As Boolean\n Dim InxAdultCrnt As Long\n Dim InxChildCrnt As Long\n Dim InxRangeCrnt As Long\n Dim NumChildrenInRange As Long\n Dim NumChildrenInRoom As Long\n Dim NumRanges As Long\n Dim RowWorkCrnt As Long\n Dim RowWorkMax As Long\n Dim StepBack As Boolean\n Dim Working() As Long\n Dim WorkingSingle() As Long\n\n NumRanges = UBound(ChildAgeRanges) - LBound(ChildAgeRanges) + 1\n\n ' Working is the array in which the details of possible combinations are\n ' accumulated in a format convenient for processing.\n ' The columns are:\n ' 1 Number of adults for this combination\n ' 2 Number of children within first age range\n ' 3 Number of children within second age range\n ' : : : : :\n ' It is theoretically possible to calculate the number of combinations for\n ' a given set of parameters. However, this would be a difficult calculation\n ' and the benefits are not obvious. With a maximum of 6 per room and 5\n ' different age ranges and no restriction of age mix, there are only 46,656\n ' combination for which the memory requirements are less than 750,000 bytes.\n ' So the array is dimensioned to hold the maximum number of combinations\n\n ColWorkMax = 1 + NumRanges\n ReDim Working(1 To ColWorkMax, 1 To MaxPersonsPerRoom ^ (1 + NumRanges))\n RowWorkMax = 0 ' The last used row\n\n ReDim WorkingSingle(1 To ColWorkMax) ' Used to build one row of Working\n\n ' Initialise WorkingSingle with:\n ' Element 1 = Minimum number of adults per room\n ' Element Max = 1\n ' Other elements = 0\n WorkingSingle(1) = MinAdultsPerRoom\n WorkingSingle(ColWorkMax) = MinChildrenPerRoom\n If MinAdultsPerRoom + MinChildrenPerRoom = 0 Then\n ' Both adults and children are optional but must have\n ' at least one person in the initial combination.\n If MaxChildrenPerRoom > 0 Then\n ' Can have a child in room\n WorkingSingle(ColWorkMax) = 1\n Else\n WorkingSingle(1) = 1\n End If\n End If\n FirstCombinationForNewNumOfAdults = True\n\n For ColWorkCrnt = 2 To ColWorkMax - 1\n WorkingSingle(ColWorkCrnt) = 0\n Next\n\n ' Output headers for diagnostics\n For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)\n Debug.Print \" R\" & InxRangeCrnt & \" = \" & ChildAgeRanges(InxRangeCrnt)\n Next\n Debug.Print Space(9) & \" A\";\n For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)\n Debug.Print \" R\" & InxRangeCrnt;\n Next\n Debug.Print\n\n Do While True\n\n ' Is WorkingSingle a valid combination?\n InvalidCombination = False\n NumChildrenInRoom = 0\n For ColWorkCrnt = 2 To ColWorkMax\n NumChildrenInRoom = NumChildrenInRoom + WorkingSingle(ColWorkCrnt)\n Next\n If NumChildrenInRoom > MaxChildrenPerRoom Then\n InvalidCombination = True\n ElseIf NumChildrenInRoom + WorkingSingle(1) > MaxPersonsPerRoom Then\n InvalidCombination = True\n End If\n\n If Not InvalidCombination Then\n ' Save accepted combination\n RowWorkMax = RowWorkMax + 1\n For ColWorkCrnt = 1 To ColWorkMax\n Working(ColWorkCrnt, RowWorkMax) = WorkingSingle(ColWorkCrnt)\n Next\n ' Output accepted combination\n Debug.Print \"Accepted \";\n For ColWorkCrnt = 1 To ColWorkMax\n Debug.Print Right(\" \" & WorkingSingle(ColWorkCrnt), 2) & \" \";\n Next\n Debug.Print\n Else\n ' Output rejected combination\n Debug.Print \"Rejected \";\n For ColWorkCrnt = 1 To ColWorkMax\n Debug.Print Right(\" \" & WorkingSingle(ColWorkCrnt), 2) & \" \";\n Next\n Debug.Print\n End If\n\n ' Find last non-zero column in WorkingSingle\n For ColWorkCrnt = ColWorkMax To 1 Step -1\n If WorkingSingle(ColWorkCrnt) > 0 Then\n Exit For\n End If\n Next\n\n If NumChildrenInRoom + WorkingSingle(1) >= MaxPersonsPerRoom Then\n ' Either this combination or the next would exceed the room limit\n If ColWorkCrnt = 1 Then\n ' All combinations have been generated\n Exit Do\n Else\n ' Can do nothing more with this column. Try previous\n WorkingSingle(ColWorkCrnt) = 0\n ColWorkCrnt = ColWorkCrnt - 1\n StepBack = True\n End If\n Else\n ' Continue with current and following columns\n StepBack = False\n End If\n\n Do While True\n ' Loop until new combination generated or no new combination is possible\n ' FirstCombinationForNewNumOfAdults ensure that if zero children are\n ' permitted, so first non-zero column is 1, the number of adults is\n ' not immediately stepped.\n If ColWorkCrnt = 1 And Not FirstCombinationForNewNumOfAdults Then\n ' Adult column\n WorkingSingle(ColWorkCrnt) = WorkingSingle(ColWorkCrnt) + 1\n WorkingSingle(ColWorkMax) = MinChildrenPerRoom\n FirstCombinationForNewNumOfAdults = True\n 'Check for all combinations having been generated outside this loop\n Exit Do\n Else\n ' Child column\n FirstCombinationForNewNumOfAdults = False\n If WorkingSingle(ColWorkCrnt) >= MaxChildrenPerRange Then\n ' This column cannot be increased\n If StepBack Or ColWorkCrnt = ColWorkMax Then\n ' All combinations of following columns have been\n ' considered or there are no following columns.\n ' Can do nothing more with this column. Try previous\n WorkingSingle(ColWorkCrnt) = 0\n ColWorkCrnt = ColWorkCrnt - 1\n StepBack = True\n Else\n ' Not all possible combinations of following columns\n ' have been considered. Start with last\n WorkingSingle(ColWorkMax) = 1\n Exit Do\n End If\n Else\n ' This column can be increased\n If StepBack Or ColWorkCrnt = ColWorkMax Then\n ' All possible values for following columns have been\n ' considered or there are no following columns\n ' Step this column which is not at maximum\n WorkingSingle(ColWorkCrnt) = WorkingSingle(ColWorkCrnt) + 1\n Else\n ' Not all possible combinations of following columns\n ' have been considered\n WorkingSingle(ColWorkMax) = 1\n Exit Do\n End If\n Exit Do\n End If\n End If\n\n Loop ' until next combination generated\n\n If WorkingSingle(1) > MaxAdultsPerRoom Then\n ' All combinations have been generated\n Exit Do\n End If\n\n Loop ' until all combinations generated\n\n ' Working contains all acceptable combination\n ' Generate Results from Working\n\n ' Note this is sized ready to be written to a worksheet\n ' with the rows as the first dimension.\n ReDim Results(1 To RowWorkMax, 1 To 2)\n\n For RowWorkCrnt = 1 To RowWorkMax\n\n ' Calculate number of children and number of different age ranges\n NumChildrenInRoom = 0\n\n For ColWorkCrnt = 2 To ColWorkMax\n If Working(ColWorkCrnt, RowWorkCrnt) <> 0 Then\n NumChildrenInRoom = NumChildrenInRoom + Working(ColWorkCrnt, RowWorkCrnt)\n End If\n Next\n\n ' Note row number in Working and Results are the same\n Results(RowWorkCrnt, 1) = Working(1, RowWorkCrnt) & \"ADT\"\n Results(RowWorkCrnt, 2) = \"\"\n If NumChildrenInRoom > 0 Then\n Results(RowWorkCrnt, 1) = Results(RowWorkCrnt, 1) & \"+\" & NumChildrenInRoom & \"CHD\"\n For ColWorkCrnt = 2 To ColWorkMax\n NumChildrenInRange = Working(ColWorkCrnt, RowWorkCrnt)\n If NumChildrenInRange > 0 Then\n If NumChildrenInRange = NumChildrenInRoom Then\n ' All children in combination have same age range\n Results(RowWorkCrnt, 2) = ChildAgeRanges(ColWorkCrnt - 2 + LBound(ChildAgeRanges))\n Else\n ' Children are of different age ranges\n Do While NumChildrenInRange > 0\n Results(RowWorkCrnt, 2) = Results(RowWorkCrnt, 2) & _\n ChildAgeRanges(ColWorkCrnt - 2 + LBound(ChildAgeRanges))\n NumChildrenInRange = NumChildrenInRange - 1\n Loop\n End If\n End If\n Next\n End If\n Next\n\nEnd Sub\nSub OutParametersAndResults(ByVal WshtName As String, ByRef ColOut As Long, _\n ByVal MinAdultsPerRoom As Long, ByVal MaxAdultsPerRoom As Long, _\n ByVal MinChildrenPerRoom As Long, ByVal MaxChildrenPerRoom As Long, _\n ByVal MaxPersonsPerRoom As Long, ByRef ChildAgeRanges() As String, _\n ByVal MaxChildrenPerRange As Long, ByRef Results() As String)\n\n ' Output the parameters and results for a call of Generate.\n\n ' WshtName The name of the worksheet to which the parameters and results\n ' are to be output.\n ' ColOut The rows used by the routine are fixed with output of\n ' parameters starting on row 3. The value of ColOut determines\n ' the first of the three columns used. At the end of routine\n ' ColOut is stepped by 4 so if the routine is called again,\n ' output will be further to the right.\n ' Other parameters Copies of the parameters for and results from macro Generate.\n\n Dim InxRangeCrnt As Long\n Dim Rng As Range\n Dim RowCrnt As Long\n\n With Worksheets(WshtName)\n\n .Cells(3, ColOut + 1).Value = \"Minimum\"\n .Cells(3, ColOut + 2).Value = \"Maximum\"\n .Cells(4, ColOut).Value = \"Adults per room\"\n .Cells(4, ColOut + 1).Value = MinAdultsPerRoom\n .Cells(4, ColOut + 2).Value = MaxAdultsPerRoom\n .Cells(5, ColOut).Value = \"Children per room\"\n .Cells(5, ColOut + 1).Value = MinChildrenPerRoom\n .Cells(5, ColOut + 2).Value = MaxChildrenPerRoom\n .Cells(6, ColOut).Value = \"Persons per room\"\n .Cells(6, ColOut + 2).Value = MaxPersonsPerRoom\n .Cells(7, ColOut).Value = \"Children per range\"\n .Cells(7, ColOut + 2).Value = MaxChildrenPerRange\n .Cells(8, ColOut).Value = \"Age ranges\"\n RowCrnt = 8\n For InxRangeCrnt = LBound(ChildAgeRanges) To UBound(ChildAgeRanges)\n .Cells(RowCrnt, ColOut + 1).Value = ChildAgeRanges(InxRangeCrnt)\n RowCrnt = RowCrnt + 1\n Next\n\n RowCrnt = RowCrnt + 1\n\n Set Rng = Range(.Cells(RowCrnt, ColOut), .Cells(RowCrnt + UBound(Results) - 1, ColOut + 1))\n Rng.Value = Results\n Rng.Sort Key1:=.Cells(RowCrnt, ColOut), Order1:=xlAscending, _\n Key2:=.Cells(RowCrnt, ColOut + 1), Order2:=xlAscending, _\n Header:=xlNo\n\n Rng.EntireColumn.AutoFit\n\n End With\n\n ' Prepare for possible further output\n ColOut = ColOut + 4\n\nEnd Sub\n<\/code><\/pre>\n<\/p><\/div>\n