AW: Permutationen ohne Wiederholung auflisten
04.09.2009 11:54:41
JogyB
Und weil es grade so Spaß macht:
Hier noch eine Variante, bei der keine Zwischenergebnisse verworfen werden müssen:
' Gibt alle Kombinationen von n Ziehungen von maxNum Zahlen ohne Zurücklegen
' und ohne Anordnung
' Bei nicht sinnvollen Kombinationen wird FALSE zurückgegeben
Function Mischen(ByVal maxNum As Long, ByVal zieHungen As Long) As Variant
Dim i As Long
Dim k As Long
Dim l As Long
Dim ergArr() As String
Dim tempArr() As String
Dim tempStr As String
Const trennZ = " "
If zieHungen > maxNum Then
' Alternativ Fehlerwert (hinter Kommentar)
Mischen = False 'CVErr(xlErrValue)
Exit Function
End If
ReDim tempArr(0)
ReDim ergArr(1 To maxNum - zieHungen + 1)
' Da es sich auf eine austeigende Folge zurückführen läßt,
' können nur Anfangszahlen vorkommen, die auch Platz für
' diese Folge lassen
For i = 1 To maxNum - zieHungen + 1
ergArr(i) = i
Next
' Ab zweiter Ziehung
For i = 2 To zieHungen
' Alle Ergebnisse aus erster Ziehung verwenden
For k = 1 To UBound(ergArr)
' Da "ohne Zurücklegen, ohne Anordnung" kann alles in
' stetig aufsteigende Zahlenfolgen überführt werden
' wie oben brauchen nur Zahlen verwendet werden, die dann auch Platz
' für die weitere Folge lassen, es geht also bis maxNum - (Anzahl folgender Ziehungen)
For l = Split(ergArr(k), trennZ)(i - 2) + 1 To maxNum - zieHungen + i
If UBound(tempArr) = 0 Then
ReDim tempArr(1 To 1)
Else
ReDim Preserve tempArr(1 To UBound(tempArr) + 1)
End If
tempArr(UBound(tempArr)) = ergArr(k) & trennZ & l
Next
Next
' tempArr ist der neue Ergebnis-Array
ergArr = tempArr
' Alten Ergebnis-Array zurücksetzen
ReDim tempArr(0)
Next
Mischen = ergArr
End Function
Tut der Laufzeit bei großen Zahlen gut.
Gruss, Jogy