Alle möglichen Kombination abbilden

[Deggit]

Hallo,

ich bin gerade etwas am verzweifeln und hoffe Ihr könnt mir weiterhelfen.

Ich müsste mit einem Makro Excel dazu bewegen alle möglichen Kombinationen zu bilden:

Im Moment haben ich zwei Arbeitsblätter (Tabelle1 und Tabelle2) in Tabelle1 stehen meinen Ausgangsdaten in Tabelle2 möchte ich alle Kombinationen abbilden.

Also so:
Tabelle1
Spalte A
A1
A2
A3

Spalte B
B1
B2

Spalte C
C1
C2

usw. insgesamt werde ich später 8 Spalten haben und jede Spalte hat 3-20 Einträge, wird also alles recht groß

Tabelle2 würde dann so aussehen (A1 würde halt in Spalte A stehen, B1 in B, C1 in C usw. )
A1 B1 C1
A1 B1 C2

A1 B2 C1
A1 B2 C2

A2 B1 C1
A2 B1 C2

A2 B2 C1
A2 B2 C2

A3 B1 C1
A3 B1 C2

A3 B2 C1
A3 B2 C2

insg. würde es hier also 12 Kombinationen geben. Noch überschaubar, aber wenn ich dann später nicht mehr 2 oder 3 Einträge pro Spalte habe sonder 10 dann kommt da ja schon einen riesige Tabelle2 bei raus.

Im Moment probiere ich es so:

Code:

Private Sub CommandButton21_Click()
   
   Set WS1 = Worksheets("Tabelle1")
   Set WS2 = Worksheets("Tabelle2")

   Dim a As Integer
   Dim b As Integer
   Dim c As Integer
   Dim d As Integer
   Dim e As Integer
   Dim f As Integer
   Dim g As Integer
   Dim h As Integer
   
   For a = 1 To Range("A1").End(xlDown).Row
       WS2.Cells(a, 1) = WS1.Cells(a, 1).Value
       
       For b = 1 To Range("B1").End(xlDown).Row
           WS2.Cells(b, 2) = WS1.Cells(b, 2).Value
           
           For c = 1 To Range("C1").End(xlDown).Row
               WS2.Cells(b, 3) = WS1.Cells(b, 3).Value
           
               For d = 1 To Range("D1").End(xlDown).Row
                   WS2.Cells(d, 4) = WS1.Cells(d, 4).Value
               
                   For e = 1 To Range("E1").End(xlDown).Row
                       WS2.Cells(e, 5) = WS1.Cells(e, 5).Value
           
                       For f = 1 To Range("F1").End(xlDown).Row
                           WS2.Cells(f, 6) = WS1.Cells(f, 6).Value
                       
                           For g = 1 To Range("G1").End(xlDown).Row
                               WS2.Cells(g, 7) = WS1.Cells(g, 7).Value
           
                               For h = 1 To Range("H1").End(xlDown).Row
                                   WS2.Cells(h, 8) = WS1.Cells(h, 8).Value
                               Next h
                           Next g
                       Next f
                   Next e
               Next d
           Next c
       Next b
   Next a
End Sub

Der hängt sich aber immer auf

Ich habe auch mal die Datei angefügt.

viele liebe Grüße,
Deg

[Deggit]

Hat hier keiner eine Idee?

viele Grüße,
Deg

[coemm]

Hallo Deg,

Hat hier keiner eine Idee?

doch! Tante Google.

Ich habe in 5 Minuten dies gefunden!

[Deggit]

Hi conny,

danke dir!

Ich habe auch noch etwas gesucht und gerade dies gefunden

http://www.office-loesung.de/ftopic455234_0_0_asc.php

klappt noch etwas besser. Nur für den Fall, dass jemand das gleiche Problem hat.

viele Grüße und DANKE
Deg