在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