|
Guten Abend zusammen,
ich habe bereits vor über einem Monat versucht eine Antwort bzgl. meiner Frage zu bekommen, war leider jedoch erfolglos. Nun versuche ich es erneut und freue mich auf eure Ideen :)
Grob gesagt geht es um einen Vektor, wessen Einträge in ihrer Reihenfolge so verändert werden, dass ich alle Anordnungsmöglichkeiten erhalte. Dies macht mein unten aufgeführter Code bereits, jedoch generiert er auch "doppelte" Möglichkeiten, da gleiche Ziffern miteinander vertauscht werden, was für mich keinen neuen Fall darstellt.
Stand:
1. Ein Vektor mit einer variablen Länge (in meinem Code Arr genannt)
2. Eine gewisse Anzahl an Stellen dieses Vektors, welcher mit 1en oder 2en gefüllt werden darf (in meinem Code A_NmaxVal genannt)
3. Mein Code generiert alle Anordnungsmöglichkeiten dieses Vektors (Vertauschen der Zeichenreihenfolge)
Problem:
Der Permutationscode (Function permutation) generiert auch doppelte Möglichkeiten (vertauscht z. B. eine 0 mit einer 0 im Vektor)
-> Je nach Fall (Größe von Arr oder A_NmaxVal) dauert es sehr lange bis alle Möglichkeiten gefunden werden
Anschließend lösche ich alle doppelten Möglichkeiten (dieser Programmcode wird in meinem unten gezeigten Codeschnipsel nicht ausgeführt).
Ziel:
Generierung von allen unterschiedlichen Möglichkeiten ohne doppelte Möglichkeiten zu berechnen um Rechenzeit zu sparen
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | Sub s_Array_erstellen()
Arr = Array(1, 2, 3, 4, 5)
s_Faelle_erstellen (Arr)
End Sub
Sub s_Faelle_erstellen(b)
strVal1 = "=1"
strVal2 = "=2"
A_NmaxVal = 3
a = b
For i = 0 To UBound(a)
a(i) = 0
Next
For j = 0 To A_NmaxVal - 1
For l = 0 To j
a(l) = strVal1
Call permutation(a, 0)
Next
For m = 0 To j
a(m) = strVal2
Call permutation(a, 0)
Next
Next
End Sub
Function permutation(ByVal a, k)
If k = UBound(a) Then
Zeile = Cells(65536, 1).End(xlUp).Row
If Cells(1, 1) <> "" Then Zeile = Zeile + 1
ActiveSheet.Range(Cells(Zeile, 1), Cells(Zeile, UBound(a) + 1)).FormulaArray = a
Exit Function
Else
For i = k To UBound(a)
x = a(i)
a(i) = a(k)
a(k) = x
Call permutation(a, k + 1)
Next
End If
End Function
|
Vielen Dank bereits im Voraus.
LG Daniel
|