Tabelle umbauen

[vasy]

Guten Tag, 

ich würde mich über ein paar Anregungen zu diesem Problem freuen: 

Ist:                             

Nr         Gruppe

1.           A
             B
             C
             D
2           H
             L
             U

Soll:

Nr.         Gruppe

1           AB
             AC
             AD
             BC
             BD
             CD....

Ich habe hier also Gruppen untereinander stehen und möchte diese so verbinden wie in diesem Beispiel, also möchte ich Paare bilden. 

Den Anfang habe ich auch schon gemacht, nur muss ich VBA irgendwie beibringen, dass es nur eine bestimmte Anzahl von Duplikaten erstellen soll, hier bspw. das A gemeint und das verbinden soll. 

Code:

Option Explicit
Sub X()

Dim rngBereich As Range
Dim rngZelle As Range

Set rngBereich = Range("A2:A13")

For Each rngZelle In rngBereich

If rngZelle = "" Then
    rngZelle.Offset(0, 1).Cut
    rngZelle.Offset(-1, 2).Insert
    End If
    Next

Call Kopieren

End Sub

Sub Kopieren()

Dim rngBereich2 As Range
Dim rngZelle2 As Range

Set rngBereich2 = Range("B2:B13")

For Each rngZelle2 In rngBereich2

If rngZelle2 = "" Then
    rngZelle2.Offset(-1, 0).Copy
    rngZelle2.PasteSpecial (xlPasteValues)
    End If
    Next

End Sub

Mein Code momentan, nichts weltbewegendes. 
Mir kam gerade der Gedanke, über die freien Felder zu zählen oder alles zu wiederholen, also dann würde überall die 1, 2 etc. stehen und dann darüber, aber auch hier muss ich dann das "Alte" aussieben... 

Danke euch!

[NobX]

Hallo,

gibt es denn hier irgend eine Regel, nach welcher die Gruppen zusammenzusetzen sind?
Weshalb kommt nach AD nicht AH und AL und AU, sondern auf ein mal BC und BD?

Grüße

NobX

[LCohen]

Für 2021+/Web/365:

COMBIN.LIST()

Ältere:

Excelformeln.de Nr. 346

NobX: Weil Nr. 1 da zuende ist.

[vasy]

Guten Morgen NobX&LCohen,

nein es gibt keinerlei Regeln. Nochmals zur Veranschaulichung:
                A                   B
1         Nummer           Gruppe
2              1                    H
3                                    X
4                                   AB
5                                 XCVB
6              2                    Ö
7                                    Ä
8                                    X
9                                    N
10         .....                  .......
11
12

Es geht mir nur darum, dass jede Gruppe so oft dupliziert wird, wie es Möglichkeiten unter ihr gibt, bis die neue Nummer beginnt. Alle Zeilen sind unterschiedlichen, also kann es bspw. sein, dass Nummer 3 18 Gruppen hat usw.
Lösung für 1 wäre bspw. HX;HAB;HCVB;XAB;XXCVB;ABXCVB und das hätte ich dann gerne untereinander. 

Vielen Dank @LCohen, nur leider hilft mir das nicht weiter...

[snb]

Und wozu brauchst du dann diese Kombinationen ?

Code:

Sub M_snb()
  sn = Cells(1).CurrentRegion
  
  For j = 1 To UBound(sn)
     For jj = j + 1 To UBound(sn)
       If sn(jj, 1) <> "" Then Exit For
       If sn(jj, 1) = "" Then c00 = c00 & " " & sn(j, 2) & "_" & sn(jj, 2)
     Next
   Next
  
  MsgBox c00
End Sub

[vasy]

Guten Tag, 

das sieht klasse aus, Danke :) Ich möchte in einem zweiten Schritt auswerten, wie oft welche Kombi vorkommt und möchte Excel nicht in Sachen Tiefe (horizontal) belasten. 
In einer meiner Excelfragen, hatte ich eine Antwort bekommen, nur reagiert Excel ganz schlecht auf Tiefe... und ic dachte mir, wenn ich die verkürze, läufts besser was auch stimmt (manuell testweise verkürzt)
Lässt sich dein Code auch in Zeilen untereinander ausgeben?

[snb]

Dann solttest du meinen Vorschlag anpassen müssen.

[vasy]

Ich dachte ich hätte es gelöst und hab die Hälfte übersehen...

[vasy]

Nebeneinander bekomme ich es hin, untereinander leider nicht...

[NobX]

Hallo,

habe ein wenig auf der Seite von @snb ("VBA for Smarties: Arrays") gegoogelt und den Code von snb noch etwas ergänzt zur Ausgabe in der Spalte C ab C2 bis C30:

Code:

Sub M_snb()
  sn = Cells(1).CurrentRegion
 
  For j = 1 To UBound(sn)
     For jj = j + 1 To UBound(sn)
       If sn(jj, 1) <> "" Then Exit For
       If sn(jj, 1) = "" Then c00 = c00 & " " & sn(j, 2) & "_" & sn(jj, 2)
     Next
   Next
  a_sp = Split(c00, "_")
  Tabelle1.Range(Cells(2, 3), Cells(30, 3)).Resize(, LBound(a_sp) + 1).Value = Application.Transpose(a_sp)
  'MsgBox c00
End Sub

Grüße
NobX