Hallo,
oder das Makro aus der 1. Antwort mit Rückrunde:
Sub ErzeugeKombinationen2()
Dim LastRow As Long
Dim i As Long
Dim j As Long
Dim k As Long
Dim z As Long
Dim arrKombis As Variant
'Letzte beschrieben Zeile in Spalte A ermitteln
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
'Inhalte aus Ausgabebereich löschen
Range("C:D").ClearContents
'Anzahl der möglichen Kombinationen ermitteln
z = Application.WorksheetFunction.Combin(LastRow, 2)
'Array für Kombinationen dimensionieren - Array beginnt mit Null
ReDim arrKombis(z - 1, 1)
'Kombinationen erstellen
For i = 1 To LastRow - 1
For j = i + 1 To LastRow
arrKombis(k, 0) = Cells(i, "A").Value
arrKombis(k, 1) = Cells(j, "A").Value
k = k + 1
Next j
Next i
'Hinrunde ausgeben
'Zeilenzähler auf 1 stellen
k = 1
For i = LBound(arrKombis, 1) To UBound(arrKombis, 1)
Cells(k, "C") = arrKombis(i, 0)
Cells(k, "D") = arrKombis(i, 1)
k = k + 1
Next i
'Rückrunde
'1 leere Zeile einfügen
k = k + 1
For i = LBound(arrKombis, 1) To UBound(arrKombis, 1)
Cells(k, "C") = arrKombis(i, 1)
Cells(k, "D") = arrKombis(i, 0)
k = k + 1
Next i
End Sub
Gruß
M.O.
