在Excel中堆叠和分层框

Question

我在Excel中分层堆叠我的选项。我以类似的方式提出了这个问题，但是我现在想要提供更多的细节。如果我有n个堆叠的盒子，堆叠它们的可能选项是2^n-1。我给出一个3个盒子的例子，我们给它们起名为A，B，C和D.它们堆叠的方式并不重要，这意味着AB = BA和ABC = CAB，它们被视为1堆栈选项。其结果将是：

A，B，C，AB，BC，AC，ABC

现在我想创造出在哪，我将输入框字母一个Excel文件，它给了我一个清单所有堆叠的可能性。所以我会提供箱子和字母的数量。 （3盒，A，B，C）Excel读取它并给出单元格中的选项。

是否有可能得到对方的下面一排的选项？为n个盒子？

这可能吗？谁能帮我这个？

谢谢先进！

Answer 1

托尼Dallimore的修改后的一些代码Creating a list of all possible unique combinations from an array (using VBA)

用法：

1. 在微距 “stackBox”

   ---变 “工作表Sheet1” 工作表的名称，你想

2. 输入的框的单元格A1数

3. 输入B1的名称，C1，...等上..

4. 呼叫stackBox

输入格式&输出结果中的 “工作表Sheet1”：

3 A B C D E 
A     
B     
AB     
C     
AC     
BC     
ABC     
D     
AD     
BD     
ABD     
CD     
ACD     
BCD     
E     
AE     
BE     
ABE     
CE     
ACE     
BCE     
DE     
ADE     
BDE     
CDE 

代码：

Function stackBox() 
    Dim ws As Worksheet 
    Dim width As Long 
    Dim height As Long 
    Dim numOfBox As Long 
    Dim optionsA() As Variant 
    Dim results() As Variant 
    Dim str As String 
    Dim outputArray As Variant 
    Dim i As Long, j As Long 
    Set ws = Worksheets("Sheet1") 
    With ws 
     'clear last time's output 
     height = .Cells(.Rows.Count, 1).End(xlUp).row 
     If height > 1 Then 
      .Range(.Cells(2, 1), .Cells(height, 1)).ClearContents 
     End If 

     numOfBox = .Cells(1, 1).Value 
     width = .Cells(1, .Columns.Count).End(xlToLeft).Column 
     If width < 2 Then 
      MsgBox "Error: There's no item, please fill your item in Cell B1,C1,..." 
      Exit Function 
     End If 
     ReDim optionsA(0 To width - 2) 
     For i = 0 To width - 2 
      optionsA(i) = .Cells(1, i + 2).Value 
     Next i 

     GenerateCombinations optionsA, results, numOfBox 


     ' copy the result to sheet only once 
     ReDim outputArray(1 To UBound(results, 1) - LBound(results, 1) + 1, 1 To 1) 
     Count = 0 
     For i = LBound(results, 1) To UBound(results, 1) 
      If Not IsEmpty(results(i)) Then 
       'rowNum = rowNum + 1 
       str = "" 

       For j = LBound(results(i), 1) To UBound(results(i), 1) 
        str = str & results(i)(j) 
       Next j 
       Count = Count + 1 
       outputArray(Count, 1) = str 
      '.Cells(rowNum, 1).Value = str 
      End If 
     Next i 
     .Range(.Cells(2, 1), .Cells(UBound(outputArray, 1) + 1, 1)).Value = outputArray 
    End With 

End Function 

Sub GenerateCombinations(ByRef AllFields() As Variant, _ 
              ByRef Result() As Variant, ByVal numOfBox As Long) 

    Dim InxResultCrnt As Integer 
    Dim InxField As Integer 
    Dim InxResult As Integer 
    Dim i As Integer 
    Dim NumFields As Integer 
    Dim Powers() As Integer 
    Dim ResultCrnt() As String 

    NumFields = UBound(AllFields) - LBound(AllFields) + 1 

    ReDim Result(0 To 2^NumFields - 2) ' one entry per combination 
    ReDim Powers(0 To NumFields - 1)   ' one entry per field name 

    ' Generate powers used for extracting bits from InxResult 
    For InxField = 0 To NumFields - 1 
    Powers(InxField) = 2^InxField 
    Next 

For InxResult = 0 To 2^NumFields - 2 
    ' Size ResultCrnt to the max number of fields per combination 
    ' Build this loop's combination in ResultCrnt 

    ReDim ResultCrnt(0 To NumFields - 1) 
    InxResultCrnt = -1 
    For InxField = 0 To NumFields - 1 
     If ((InxResult + 1) And Powers(InxField)) <> 0 Then 
     ' This field required in this combination 
     InxResultCrnt = InxResultCrnt + 1 
     ResultCrnt(InxResultCrnt) = AllFields(InxField) 
     End If 
    Next 

    If InxResultCrnt = 0 Then 
     Debug.Print "testing" 
    End If 
    'additional logic here 
    If InxResultCrnt >= numOfBox Then 
     Result(InxResult) = Empty 

    Else 
     ' Discard unused trailing entries 
     ReDim Preserve ResultCrnt(0 To InxResultCrnt) 
     ' Store this loop's combination in return array 
     Result(InxResult) = ResultCrnt 
    End If 

    Next 

End Sub