Hallo Arno,
tatsächlich hatte ich einen entsprechenden Code in meinem Fundus. Hab ich vor 3 Jahren geschrieben. Allerdings lautet die Variable r bei mir k, da man normalerweise k Elemente aus n zieht. Bei Variationen mit Berücksichtigung der Reihenfolge aber eben ohne Wiederholung. Ich brauchte nur wenige Zeilen umschreiben um die Wiederholung mit einzubauen. Der folgende Code gehört in ein allgemeines Modul. (z.B. Modul1)
Sub VarIndTest()
n = 4
k = 2
wdh = True
Sheets.Add
For i = 1 To IIf(wdh, n ^ k, Application.Permut(n, k))
arr = VarIndex(n, k, i, wdh)
For p = 0 To UBound(arr)
Cells(i, p + 1) = arr(p)
Next p
Next i
End Sub
Function VarIndex(ByVal n As Long, ByVal k As Long, ByVal index As Long, Optional ByVal wdh As Boolean)
Dim Coll As New Collection
If wdh = False And IsError(Application.Permut(n, k)) Then
VarIndex = Application.Permut(n, k)
Exit Function
End If
If index < 1 Or index > IIf(wdh, n ^ k, Application.Permut(n, k)) Then Err.Raise 9
ReDim arr(k - 1) As Variant
mx = IIf(wdh, n ^ k, Application.Permut(n, k))
s = ","
For i = 1 To n
Coll.Add i
Next i
For p = 1 To k
p2 = 1: x = 0: i2 = 0
Do
x2 = x2 + x
x = IIf(wdh, n ^ (k - p), Application.Permut(n - p, k - p))
If index <= x2 + x Then
Pos = Coll(p2)
arr(p - 1) = Pos
If wdh = False Then Coll.Remove p2
Exit Do
End If
p2 = p2 + 1
Loop Until x2 + x = mx
Next p
VarIndex = arr
End Function
Die Function gibt die entsprechende Variation anhand ihres Index zurück. Die Sub geht alle Indizes durch und listet diese in einem neuen Sheet. Teste auch was passiert wenn du die Variable wdh auf False setzt. Dann hast du eine Liste mit allen Variationen ohne Wiederholung, so wie es eigentlich üblich ist. In dem Fall muss k < n sein. Sonst erhältst du einen Fehler.
Gruß Mr. K.
|