Excel/VBA/MS Abfrage, um jede mögliche Kombination eines Bereichs zu erstellen

Question

Ich habe ein Problem, für das ich keine Lösung finden konnte.

Ich habe eine Tabelle mit 5 -> 10? Spalten von Daten. Alle sind unterschiedlich, aber einige Spalten sind miteinander verwandt (wenn A3 = 1, dann B3 = A und C3 = a). Jede Spalte enthält 3 -> 6 Variationen eines Parameter und ich brauche alle möglichen Kombinationen von ihnen zu schaffen ..

Erste Daten in den Spalten:

Erwartetes Ergebnis:

Kelvin hatte fast problem vorher ähnlich, aber das hat nicht für mich funktioniert.

Answer 1

Von dem, was ich in Ihren Bildern sehe, ist das einzige Element, das Kombination ändern kann, das in Spalte 4: (1; EIN ; ein ; item4; # ¤), (2; B; b; item4; & # ¤) und (3; C; c; item4; ¤% &)

Wenn dies tatsächlich, was Ihr versuchen, den folgenden Code zu tun, sollte funktionieren :

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

das können Sie verbinden mit einem Kreuz SQL. Unten ist ein kleines Beispiel, das ich gemacht und getestet habe. Sie müssen es an Ihre Bedürfnisse anpassen. In meinem Beispiel sind test1 und test3 die Spaltennamen in der ersten Zeile von 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 

Beispiel