ich bin auf der Suche nach einem Makro-Code, welcher mir alle möglichen Kombinationen von unterschiedlichen Begriffen auflistet. Demnach spreche ich von einer Permutation ohne Wiederholung.
Beispiel mit den Begriffen - rot - gelb - grün -:
rot gelb grün
rot grün gelb
gelb rot grün
gelb grün rot
grün rot gelb
grün gelb rot
Annähernd fündig wurde ich bereits hier im Forum:
https://www.herber.de/forum/archiv/1256to1260/1258939_alle_moegl_Zellenkombinationen_mit_Makro_auflisten.html#top
Bei diesem Beitrag sind zwei Lösungen genannt worden, die für meinen Fall Schwächen und Stärken besitzen.
Ich habe die Excel-Datei von Toni hier angefügt und darin auch die Schwäche des Makros markiert:
https://www.herber.de/bbs/user/102234.xlsm
Schwäche:
- manche Kombinationen werden doppelt oder vierfach aufgelistet (siehe Markierungen). Entsprechend ist die Kombinationsbildung leider fehlerhaft.
Stärken:
+ Anzahl der zu kombinierenden Begriffe ist unbegrenzt
+ Ausgabe der Kombinationen in einer Excel-Datei
Mein Wunsch:
--> Makro-Code müsste so geschrieben sein, dass eine Permutation ohne Wiederholung gegeben ist.
Damit wäre dieser Code zu 100 % genau das was ich brauche!!!
der Code von Rudi Maintaire:
Const strDelim As String = "|"
Sub SpaltenKombinieren()
Application.ScreenUpdating = False
Dim objKombi As Object, rngC As Range, lngCount As Long
Dim arrKombi(), arrTmp, i As Long, j As Long
Dim colKombi As New Collection
Set objKombi = CreateObject("Scripting.Dictionary")
For Each rngC In Range("A:C").Columns
colKombi.Add _
Range(Cells(1, rngC.Column), Cells(Rows.Count, rngC.Column).End(xlUp)).Value
Next
Kombinieren_a colKombi, , objKombi
If objKombi.Count > Rows.Count - 1 Then
MsgBox "Zu viele Kombinationen (" & objKombi.Count & ")", , "Fehler"
Else
ReDim arrKombi(1 To objKombi.Count, 1 To colKombi.Count)
For i = 1 To objKombi.Count
arrTmp = Split(objKombi(i), strDelim)
For j = 1 To colKombi.Count
arrKombi(i, j) = arrTmp(j - 1)
Next j
Next i
Workbooks.Add (1)
Sheets(1).Cells(1, 1).Resize(UBound(arrKombi), UBound(arrKombi, 2)) = arrKombi
End If
Set objKombi = Nothing
For lngCount = 1 To colKombi.Count
colKombi.Remove 1
Next
Application.ScreenUpdating = True
End Sub
Sub Kombinieren_a(colKombi, Optional strAusgabe As String, Optional objKombi)
Dim i As Long, arrValues, j As Integer
Static lngStep As Long
lngStep = lngStep + 1
If IsArray(colKombi(lngStep)) Then
For i = 1 To UBound(colKombi(lngStep))
If lngStep 0 Then
ReDim arrTmp(UBound(arrValues) - 1)
For i = 0 To UBound(arrValues)
If strErg = "" Then
strTmp = arrValues(i)
Else
strTmp = strErg & strDelim & arrValues(i)
End If
k = 0
For j = 0 To UBound(arrValues) - 1
If i = j Then k = 1
arrTmp(j) = arrValues(j + k)
Next j
Kombinieren_b arrTmp, strTmp, objErg
Next i
Else
objErg(objErg.Count + 1) = strErg & strDelim & arrValues(0)
End If
End Sub
Schwächen:
- nur 3 Begriffe bzw. 3 Spalten mit Begriffen möglich
- ein neue Excel-Datei öffnet sich zur Ausgabe der Kombinationen
Stärke:
+ die Permutation ohne Wiederholung ist richtig!
Mein Wunsch:
--> es müssten unbegrenzt Begriffe möglich sein
--> die Ausgabe der Kombinationen sollte in einer Excel-Datei erfolgen
Zusammenfassend lässt sich sagen, dass die Stärke der einen Lösung, die Schwäche der anderen ist und umgekehrt.
Ich wäre wirklich sehr dankbar, wenn sich einer der beiden Schöpfer der Makro-Codes auf meinen Beitrag hier im Forum melden würde!
Vielen vielen Dank schon mal im Voraus!
Gruß
Mark