스태킹 및 레이어 상자가 Excel에서 제공

Question

나는 겹겹이 쌓여있어 내 옵션이 Excel에 스태킹되어 있습니다. 나는 비슷한 방식으로 질문을했지만, 이제 좀 더 자세히 설명하고 싶다. 스택에 n 개의 상자가있는 경우 스택 할 수있는 옵션은 2^n-1입니다. 예를 들어 3 개의 박스를 예로 들어 보겠습니다. A, B, C 및 D라는 이름을 붙이십시오. 스택되는 방식은 중요하지 않습니다. AB = BA 및 ABC = CAB을 의미합니다. 스택 옵션은 1로 계산됩니다. 그 결과는 다음과 같습니다

A, B, C, AB, BC, AC, ABC

이제

내가있는 내가 상자에 문자를 입력 할 엑셀 파일을 생성하고 싶은하고 나에게 목록을 제공 스태킹의 모든 가능성을 보여줍니다. 그래서 상자와 글자의 수를 제공합니다. (3 박스, A, B, C) Excel이 이것을 읽고 셀에 옵션을 제공합니다.

옵션을 서로 아래에 연속적으로 표시 할 수 있습니까? n 개의 상자에 대해?

이것이 가능합니까? 아무도 이것으로 나를 도울 수 있습니까?

고맙습니다! 토니 Dallimore의 게시물에서 수정

Answer 1

일부 코드 Creating a list of all possible unique combinations from an array (using VBA)

사용 :

매크로 "stackBox"에서

1. 가 --- 워크 시트 이름 변경 "Sheet1의는"당신이

2. 을 원하는 A1 셀에 상자 수를 입력하십시오. B1, C1, ... 등의 이름을 입력하면 셀 A1에 상자 수를 입력하십시오. 에 ... "시트 1"에서

3. 전화 stackBox

입력 형식 & 출력 결과 :

는

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