kombination aus bestimmten zahlen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim Zahlen Dim Anz As Long Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long Dim Zeile As Long Dim Erg Anz = Range("Anz") ReDim Erg(1 To Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5) * (Anz - 6), 1 _ To 6) Zahlen = Range("Zahlenliste").Resize(Anz, 1) Zeile = 0 Range("C:H").ClearContents For i = 1 To Anz Application.StatusBar = "Bearbeitet: " & Format(i / Anz, "0%") For j = 1 To Anz For k = 1 To Anz For l = 1 To Anz For m = 1 To Anz For n = 1 To Anz If Not (i = j Or i = k Or i = l Or i = m Or i = n Or n) Then Zeile = Zeile + 1 Erg(Zeile, 1) = Zahlen(i, 1) Erg(Zeile, 2) = Zahlen(j, 1) Erg(Zeile, 3) = Zahlen(k, 1) Erg(Zeile, 4) = Zahlen(l, 1) Erg(Zeile, 5) = Zahlen(m, 1) Erg(Zeile, 6) = Zahlen(n, 1) End If Next Next Next Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2), UBound(Erg, 3), UBound(Erg, 4), UBound(Erg, _ 5)) = Erg Application.StatusBar = False End Sub

Hi
also mal Fehler eins:
bei der Berechnung der Dimensionierung ist ein Faktor zu viel drin, du rechnest mit 7, brauchst aber nur 6, dh (Anz-6) kann entfallen


ReDim Erg(1 To Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5) * (Anz - 6)
, 1  To 6)

Fehler zwei liegt hier:


Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2), UBound(Erg, 3), UBound(Erg, 4), UBound(Erg,   _
_
5)) = Erg

Erg ist nur ein 2 Dimensionalse Feld (egal, mit vielen Werten du rechnest, und wir müssen nur den Zellbeeich, in den wir ERG zurückschreiben wollen, genauso gross machen, wie ERG: dh. das hier reicht:


Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2)) = Erg

das eigentliche Problem ist diese Zeile:


If Not (i = j Or i = k Or i = l Or i = m Or i = n Or n) Then

hier müsstset du jeden Schleifenzähler miteinder vergleichen, denn die Kombinationen sollen ja nur zurückgeschrieben werden, wenn jeder der Zähler einen anderen Wert hat.
insgesamt müsstest du bei 6 Werten 15 Vergleichsoperationen haben, von denen keiner gleich sein darf.
da bin ich jetzt auch etwas überfragt, das wird dann wohl etwas aufwendiger.
Gruß Daniel

Sub test() Dim Zahlen Dim Anz As Long Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long Dim Zeile As Long Dim Erg Anz = Range("Anz") ReDim Erg(1 To Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5), 1 To 6) Zahlen = Range("Zahlenliste").Resize(Anz, 1) Zeile = 0 Range("C:H").ClearContents For i = 1 To Anz Application.StatusBar = "Bearbeitet: " & Format(i / Anz, "0%") For j = 1 To Anz For k = 1 To Anz For l = 1 To Anz For m = 1 To Anz For n = 1 To Anz If Not (i = j Or i = k Or i = l Or i = m Or i = n Or n) Then Zeile = Zeile + 1 Erg(Zeile, 1) = Zahlen(i, 1) Erg(Zeile, 2) = Zahlen(j, 1) Erg(Zeile, 3) = Zahlen(k, 1) Erg(Zeile, 4) = Zahlen(l, 1) Erg(Zeile, 5) = Zahlen(m, 1) Erg(Zeile, 6) = Zahlen(n, 1) End If Next Next Next Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2)) = Erg Application.StatusBar = False End Sub

Sub test() Dim Zahlen Dim Anz As Long Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long Dim Zeile As Long Dim Erg Anz = Range("Anz") ReDim Erg(1 To Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5), 1 To 6) Zahlen = Range("Zahlenliste").Resize(Anz, 1) Zeile = 0 Range("C:H").ClearContents For i = 1 To Anz Application.StatusBar = "Bearbeitet: " & Format(i / Anz, "0%") For j = 1 To Anz For k = 1 To Anz For l = 1 To Anz For m = 1 To Anz For n = 1 To Anz If Not (i = j Or i = k Or i = l Or i = m Or i = n Or n) Then Zeile = Zeile + 1 Erg(Zeile, 1) = Zahlen(i, 1) Erg(Zeile, 2) = Zahlen(j, 1) Erg(Zeile, 3) = Zahlen(k, 1) Erg(Zeile, 4) = Zahlen(l, 1) Erg(Zeile, 5) = Zahlen(m, 1) Erg(Zeile, 6) = Zahlen(n, 1) End If Next Next Next Next Next Next Cells(1, 6).Resize(UBound(Erg, 1), UBound(Erg, 2)) = Erg Application.StatusBar = False End Sub

Hi
nein, kleiner Irrtum, der Fehler liegt wo anders
in der Redim-Zeile legst du die Grösse des Arrays fest, dh. du kannt nur soviele Werte reinschreiben, wie du hier angibst.
die Anzahl der möglichen Werte wird innerhalb der ReDim - Anweisung berechnet, und zwar mit der Formel:


Anz * (Anz - 1) * (Anz - 2) * (Anz - 3) * (Anz - 4) * (Anz - 5)

genau so gross, wie es bei 6 Werten Kombinationsmöglichkeiten gibt, wenn jeder Wert nur GENAU EINMAL vorkommen darf.
deine Prüfvorschrift


If Not (i = j Or i = k Or i = l Or i = m Or i = n Or n) Then

ist aber nicht ausreichend , dh sie lässt noch Kombinatioinen zu, in denen Werte mehrfach vorkommen, dh du bekommst irgendwann mehr Werte, als du in der Dimensionierung berechnet hast.
du müsstest hier die Prüfung so anpassen, daß nur die gewünschten Kombinationen durchkommen.
allerdings solltest du auch bedenken, daß du bei 20 Werten mit 6 Kombinationen 27.907.200 verschiedene möglichkeiten hast (wenn kein Wert dopplelt vorkommt)
Selbst wenn du wirklich jede Zelle von 65536 Zeilen * 256 Spalten ausnützen würdest, brauchst du 8 Blätter, um das Ergebnis darzustellen.
Sorry, aber da ist speicherplatztechnisch einfach GAME OVER
Gruß, Daniel

Beliebteste Forumthreads (12 Monate)

kombination aus bestimmten zahlen

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

8 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

kombination aus bestimmten zahlen

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

8 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread