EXCEL VBA可能的组合取决于细胞价值

时间:2015-01-15 14:04:28

标签: excel excel-vba vba

我是一名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”栏后未定义任何年龄(空白)但可能根据酒店发生

B2,C2,D2的值可能相对于房间大小而变化,并且“Total Pax”可能基于房间的子容量(不是单元格B2和C2的总数)而增加5,6或更多

在细胞中,给予儿童7岁(在桌上不超过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)

从组合表中可以理解,包括孩子在内的总数不能超过4。所以房间的最大容量计算为1 + 3或2 + 2或3 + 1。同样的组合的重复也被省略。

提前致谢。

1 个答案:

答案 0 :(得分:0)

根据您的最新解释并将您的示例结果与我的结果进行比较,我相信我现在了解您的要求。

您可以在工作表上放置参数,并将结果输出到同一工作表。我不想将生成代码绑定到特定的输入或输出样式,并编写了一个子程序:

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个孩子,我无法看到指定此值的位置。我现在不确定这些参数是否必要,但我决定不删除它们以防它们有用。第二个调用演示了这些参数的使用。

数组结果包含准备输出到示例中使用的样式的工作表的组合。

我的测试例程使用以下调用来输出参数和结果:

  Call OutParametersAndResults("Sheet2", ColOut, 1, 3, 1, 3, 4, ChildAgeRanges, 3, Results)   

  Call OutParametersAndResults("Sheet2", ColOut, 0, 2, 0, 4, 5, ChildAgeRanges, 4, Results)

我的输出与您的输出相似但不完全相同,因为我的输出结构便于测试。通过使用您自己的代码替换宏TestOutParametersAndResults,您可以根据需要加载参数和输出结果。宏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名儿童+ 1名儿童+ 1名儿童+ 0名儿童+ 0名儿童。

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

不生成这些组合而不测试它们可以大大缩短生成过程的持续时间。


我希望下面的代码包含足够的评论来解释它的作用和方式。诊断输出到立即窗口,以帮助测试和理解例程。

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