Excel/VBA/MS 범위의 가능한 조합을 모두 생성하는 쿼리

Question

해결 방법을 찾을 수없는 문제가 있습니다.

5 -> 10 인 스프레드 시트가 있습니까? 데이터 열 모두 다 다르지만 일부 열은 서로 관련되어 있습니다 (A3 = 1이면 B3 = A 및 C3 = a).

예상 결과 :

을 매개 변수]의> 6 변화와 나는 열 ..

초기 데이터를 모두 가능한 조합을 만들어야합니다 - 각 열은 3 포함

켈빈은 이전에 거의 비슷한 problem을 가졌지 만 나에게 도움이되지 않았습니다.

Answer 1

사진에서 볼 수있는 것부터 조합을 변경할 수있는 유일한 항목은 열 4에있는 것입니다 : (1; A; a; item4; # ¤), (2, B, B, item4, & # ¤), (3, C, C, item4, 이것은 참으로 경우 ¤ % &)

무엇 당신의 일을해야 다음 코드를하려고 노력하고 있습니다 :

Sub Combination() 

Dim i As Integer, j As Integer, k As Integer 

    For k = 0 To 2 'loop through (1 A a #¤), (2 B b &#¤) and (3 C c ¤%&) 

     j = 3 'column 4 items 

     For i = 0 To 6 Step (3) 'loop 3 by 3 (output starts in row 10) 

       Cells(10 + k + i, 1) = Cells(3 + k, 1) 
       Cells(10 + k + i, 2) = Cells(3 + k, 2) 
       Cells(10 + k + i, 3) = Cells(3 + k, 3) 
       Cells(10 + k + i, 5) = Cells(3 + k, 5) 

       Cells(10 + k + i, 4) = Cells(j, 4) 

     j = j + 1 

     Next i 

    Next k 

End Sub 

Answer 2

크로스 조인을 사용하여 SQL을 사용할 수 있습니다. 아래는 내가 만들고 테스트 한 작은 예제입니다. 당신은 당신의 필요에 적응시켜야 할 것입니다. 예제에서 test1과 test3은 첫 행에있는 sheet1의 열 이름입니다.

Sub SQLCombineExample() 
    Dim con 
    Dim rs 
    Set con = CreateObject("ADODB.Connection") 
    con.Open "Driver={Microsoft Excel Driver (*.xls)};" & _ 
      "DriverId=790;" & _ 
      "Dbq=" & ThisWorkbook.FullName & ";" & _ 
      "DefaultDir=" & ThisWorkbook.FullName & ";ReadOnly=False;" 
    Set rs = CreateObject("ADODB.Recordset") 
    Set rs = con.Execute("select distinct a.[test1], b.[test3] from [Sheet1$] as a , [Sheet1$] as b ") 
    Range("f1").CopyFromRecordset rs 
    Set rs = Nothing 
    Set con = Nothing 
End Sub 

Answer 3

Sub CopyAllCombinationsToRange() 

    Dim arSource 
    Dim arResult 

    Dim i As Long, j As Long, combinationCount As Long, counter As Long 

    arSource = Range(Cells(2, 1), Cells(Rows.Count, 5).End(xlUp)).Value 

    combinationCount = UBound(arSource, 2) * UBound(arSource, 2) 
    ReDim arResult(4, combinationCount - 1) 

    For i = 1 To UBound(arSource, 1) 
     For j = 1 To UBound(arSource, 1) 

      arResult(0, counter) = arSource(i, 1) 
      arResult(1, counter) = arSource(i, 2) 
      arResult(2, counter) = arSource(i, 3) 
      arResult(3, counter) = arSource(i, 4) 
      arResult(4, counter) = arSource(j, 5) 
      counter = counter + 1 
     Next 
    Next 

    Sheet2.Range("A1").Resize(UBound(arResult, 2), 5) = WorksheetFunction.Transpose(arResult) 

End Sub 

예