Permutationen per VBA erzeugen
Paddy
Ich habe folgendes Problem: ich möchte alle Permutationen (ohne
Wiederholungen) von den Zahlen 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 erzeugen.
Die erzeugten Permutationen sollen jeweils aus 8 Elementen bestehen.
Das heisst also zum Beispiel: 01234567, 89012345, 10234567, etc...
Die Permutationen sollen nach obigen Vorgaben per VBA erzeugt und in
einen Array geschrieben werden. Die einzelnen Permutationen aus dem
Array sollen anschliessend in Excel eingelesen werden.
Ein Lösungsansatz hierzu könnte der Artikel von Reimund Lebeis (siehe
Newsbeitrag
news:j%8c8.61$J91.56...@news.odn.de in diesem Forum) sein. Hier
sein Code:
Beginn Code:
***************
Private AnzElemente As Long
Private arrIn() As Variant
'enthält die Elemente, für die die Permutation durchgeführt werden
soll.
Private arrOut() As Long
'Enthält die Permuationen als Indices.
Public Sub Ini()
Dim i As Long
InputExcel
AnzElemente = UBound(arrIn)
ReDim arrOut(1 To AnzElemente, 1 To Fak(AnzElemente))
FillArrOut
OutputExcel
End Sub
Private Sub InputExcel()
Dim Bereich As Range
Dim Anzahl As Long, i As Long
With Sheets(1)
Set Bereich = .Cells(1, 1).CurrentRegion
Anzahl = Bereich.Cells.Count
ReDim arrIn(1 To Anzahl)
For i = 1 To Anzahl
arrIn(i) = Bereich.Cells(i).Value
Next
End With
End Sub
Private Sub OutputExcel()
Dim X As Long, Y As Long
With Sheets(1)
For X = 1 To AnzElemente
For Y = 1 To UBound(arrOut, 2)
.Cells(Y + 2, X).Value = arrIn(arrOut(X, Y))
Next
Next
End With
End Sub
Private Sub FillArrOut()
Dim Encrease As Long
Dim X As Long, Y As Long
Dim i As Long
Dim NextFree As Long
'Anfangsbedingungen:
Y = 1
For i = 1 To AnzElemente
arrOut(i, Y) = i
Next
'
Do While Y < UBound(arrOut, 2)
DoEvents
Encrease = XEncrease(Y)
Y = Y + 1
For X = 1 To AnzElemente
Select Case X
Case Is < Encrease
arrOut(X, Y) = arrOut(X, Y - 1)
Case Encrease
NextFree = NextFreeX(X, Y, arrOut(X, Y - 1))
If NextFree = 0 Then
Exit Sub
Else
arrOut(X, Y) = NextFree
End If
Case Is > Encrease
arrOut(X, Y) = NextFreeX(X, Y, 0)
End Select
Next
Loop
MsgBox "Fertig" '***********************************+
End Sub
Private Function Fak(N As Long) As Long
'Berechnet die Fakultät von N
Dim i As Long
Fak = 1
For i = 2 To N
Fak = Fak * i
Next
End Function
Private Function NextFreeX(X As Long, Y As Long, Bigger As Long) As
Long
'Ermittelt in der X-ten Permutation an der Y-ten Stelle
'den kleinsten noch freien Index, der größer ist als Bigger
'Gibt 0 zurück, wenn (im Fall Bigger > 0) kein Index mehr verfügbar
ist.
Dim N As Long, i As Long
Dim Belegt As Boolean
'Mögliche Indices durchlaufen
For N = Bigger + 1 To AnzElemente
'Für den Index prüfen, ob er in der Permutation
'von links her schon vorkommt
For i = 1 To X - 1
If arrOut(i, Y) <> N Then
Belegt = False
Else
Belegt = True
Exit For
End If
Next
If Belegt = False Then
NextFreeX = N
Exit For
End If
Next
End Function
Private Function XEncrease(Y As Long) As Long
'Stellt die Stelle (X) im Y-ten Array fest, die im
'nächsten Durchgang erhöht werden muß.
'Gibt 0 zurück, wenn keine Stelle gefunden werden kann.
Dim i As Long
For i = AnzElemente To 1 Step -1
'Suchen nach dem nächsten größeren Index;
'Wenn dieser nicht verfügbar ist, eine Stelle weiter
'links prüfen.
If NextFreeX(i, Y, arrOut(i, Y)) <> 0 Then
XEncrease = i
Exit For
End If
Next
End Function
**************************
Ende Code
Ich weiss nun nicht an welchen Schrauben ich drehen muss, um den Code
auf meine Bedürfnisse anzupassen. Vielleicht könnt ihr mir behilflich
sein. Ich bin auch für andere Lösungsansätze offen. Besten Dank für
Eure Antworten!
gruss
paddy
Alexander Wolff
> Ich habe folgendes Problem: ich möchte alle Permutationen (ohne
> Wiederholungen) von den Zahlen 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 erzeugen.
> Die erzeugten Permutationen sollen jeweils aus 8 Elementen bestehen.
> Das heisst also zum Beispiel: 01234567, 89012345, 10234567, etc...
Da hast Du Glück (ohne VBA):
http://excelformeln.de/formeln.html?welcher=325
läßt gerade 8 Bestandteile zu - ab Excel 2007 auch mehr.
--
Moin + Gruss Alexander - XPHome SP2 MSO 2000 SP3 +----5----6----5----7-2
Andreas Stoye
Alexander schrieb:
Zur Kontrolle: Die Anzahl möglicher Permutationen ist:
(n)s = n!/(n-s)! wobei n=10 und s=8. Das ergibt immerhin 1,814,400
Permutationen. Viel Spaß!
mfg Andreas
Alexander Wolff
>>> Ich habe folgendes Problem: ich möchte alle Permutationen (ohne
>>> Wiederholungen) von den Zahlen 0, 1, 2, 3, 4, 5, 6, 7, 8, 9
>>> erzeugen. Die erzeugten Permutationen sollen jeweils aus 8
>>> Elementen bestehen. Das heisst also zum Beispiel: 01234567,
>>> 89012345, 10234567, etc...
>>
>> Da hast Du Glück (ohne VBA):
>> http://excelformeln.de/formeln.html?welcher=325
>> läßt gerade 8 Bestandteile zu - ab Excel 2007 auch mehr.
>
> (n)s = n!/(n-s)! wobei n=10 und s=8. Das ergibt immerhin 1,814,400
> Permutationen. Viel Spaß!
Stimmt .. hab ich überlesen.
Paddy
Danke für Eure Hinweise! Ich bin meiner Lösung wieder ein Schrittchen
näher gekommen (mit VBA). Habe auf dieser Seite
http://www.vbarchiv.net/archiv/tipp_68.html folgenden Code gefunden:
*** Code Anfang ***
'Beispiel : Rekursive Permutation.
Private strPermutation As String
Private strZeichen As String
Private intArray_Pos() As Integer
Private intArray_Pos_Zeiger As Integer
Private strErgebnis() As String
Private lngCount As Long
Public Sub Rekursive_Permutation(strUebergabe As String)
strZeichen = strUebergabe
intArray_Pos_Zeiger = -1
ReDim intArray_Pos(Len(strZeichen) - 1)
Call Permutation(0)
End Sub
Private Sub Permutation(intX As Integer)
Dim i As Integer
intArray_Pos_Zeiger = intArray_Pos_Zeiger + 1
intArray_Pos(intX) = intArray_Pos_Zeiger
If intArray_Pos_Zeiger = Len(strZeichen) Then
strPermutation = ""
For i = 0 To UBound(intArray_Pos)
strPermutation = strPermutation & _
Mid$(strZeichen, intArray_Pos(i), 1)
Next i
lngCount = lngCount + 1^
ReDim Preserve strErgebnis(lngCount)
strErgebnis(lngCount) = strPermutation
Else
For i = 0 To Len(strZeichen) - 1
If intArray_Pos(i) = 0 Then Call Permutation(i)
Next i
End If
intArray_Pos_Zeiger = intArray_Pos_Zeiger - 1
intArray_Pos(intX) = 0
End Sub
*** Code Ende ***
Habe mir folgende Testprozedur zusammengebastelt:
*** Mein Code Anfang ***
Sub PermutationTest()
Dim ÜbergabeZahlen As String
Dim i As Long
ÜbergabeZahlen = "0123456789"
Call Rekursive_Permutation(ÜbergabeZahlen)
Debug.Print "Anzahl Kombinationsmöglichkeiten: " & lngCount
For i = 1 To lngCount
Debug.Print strErgebnis(i)
Next i
End Sub
*** Mein Code Ende ***
Das Ding macht nun (fast :-( ) genau das was ich will. Nachteil: Die
einzelnen Permutationen bestehen immer aus allen 10 Elementen und nicht
aus den geforderten 8 Elementen.... Wie müsste ich den obigen Code
ergänzen um auch diesem Umstand noch Rechnung zu tragen?
Ich denke aber, dass ich mit diesen 10-10 Permutationen auch die
Permutationen aus den 10-8 Permutationen dabei habe, oder? Wäre aber
dennoch schön, wenn dies noch geändert werden könnte, da sich dies
positiv auf die Laufzeit auswirken würde.... Gemäss Andreas'
Fakultät-Formel habe ich bei den 10-10 Permutationen 3,628,800
Permutationen zu erzeugen. Also doch eine ganze Latte mehr....
Vielleicht könnt ihr (ich akzeptiere natürlich auch gerne Hilfe von
anderen Personen ;-) )mir ja nochmals ein bisschen Hilfestellung geben?
Besten Dank!
gruss
paddy
Helmut Weber
>ÜbergabeZahlen = "0123456789"
dann eben zwei Ziffern weglassen.
>ÜbergabeZahlen = "01234567"
Oder?
--
Gruß
Helmut Weber, MVP WordVBA
"red.sys" & chr$(64) & "t-online.de"
Win XP, Office 2003 (US-Versions)
Paddy
Hallo Helmut,
> >ÜbergabeZahlen = "01234567"
> Oder?
So einfach gehts dann doch nicht.... Dann würde ich nämlich 8-8
Permutationen erhalten. Ich will aber 10-8 Permutationen. Die Länge
wäre zwar bei allen Permutationen dann richtig, die Zahlen 8 und 9
würden aber für die Bildung der Permutationen nicht mehr
berücksichtigt.
Hier nochmals einige Beispiel-10-8-Permutationen, wie ich sie mir
vorstelle:
12845930
45671243
12784569
01457841
etc
Trotzdem danke! Vielleicht hast Du noch weitere Anregungen? Oder
sonstwer? Vielen Dank!
gruss
paddy
Helmut Weber
hmm...
möglicherweise blamiere ich mich mal wieder.
>Ich habe folgendes Problem: ich möchte alle Permutationen (ohne
>Wiederholungen) von den Zahlen 0, 1, 2, 3, 4, 5, 6, 7, 8, 9 erzeugen.
>Die erzeugten Permutationen sollen jeweils aus 8 Elementen bestehen.
>Das heisst also zum Beispiel: 01234567, 89012345, 10234567, etc...
Du willst alle Permutationen haben,
und die sollen aus nur 8 Ziffern bestehen!
Das geht doch nicht.
Dann können es nicht alle sein.
Alle Permutationen von "0123456789"
sind 10 Zeichen lang.
Paddy
Hallo Helmut
> möglicherweise blamiere ich mich mal wieder.
Ach was, hab mich vielleicht ein bisschen schwierig ausgedrückt.
> Du willst alle Permutationen haben,
> und die sollen aus nur 8 Ziffern bestehen!
> Das geht doch nicht.
> Dann können es nicht alle sein.
>
> Alle Permutationen von "0123456789"
> sind 10 Zeichen lang.
Mathematisch betrachtet möchte ich genau das erhalten, was Andreas
Stoye mit seiner Formel einleuchtend beschrieben hat. Weil Sie mir so
gut gefällt zitier' ich sie an dieser Stelle nochmals:
"Die Anzahl möglicher Permutationen ist:
(n)s = n!/(n-s)! wobei n=10 und s=8. Das ergibt immerhin 1,814,400
Permutationen."
Genau! Mit den obigen Beispielen sollte es jetzt vielleicht ein
bisschen klarer sein.... Bis bald ;-)
gruss
paddy
Andreas Stoye
Helmut Weber schrieb:
>
> Du willst alle Permutationen haben,
> und die sollen aus nur 8 Ziffern bestehen!
> Das geht doch nicht.
> Dann können es nicht alle sein.
>
> Alle Permutationen von "0123456789"
> sind 10 Zeichen lang.
>
Es entspricht gedanklich dem Fall: Du hast eine Urne mit 10 verschiedenen
Bällen und ziehst 8. Wieviele verschiedene Reihenfolgen (Permutationen) sind
dann möglich?
Alternatives Modell: 6 aus 49 u.a.m.
mfg Andreas
Andreas Stoye
"Andreas Stoye" <Jem...@microsoft.com> schrieb im Newsbeitrag
news:eaBY6gB1...@TK2MSFTNGP02.phx.gbl...
1 - 5 entsprcht. In Paddys Frage ist das nicht so.
mfg Andreas
>
>
Jens Warnke
> Hallo Helmut
>
>> möglicherweise blamiere ich mich mal wieder.
>
> Ach was, hab mich vielleicht ein bisschen schwierig ausgedrückt.
Ja, hast du. Was du suchst, sind nicht
Permutationen (mögliche Anordnungen einer endlichen Menge von Zahlen),
sondern
Variationen (Auswahl von s Elementen aus einer Menge von n Elementen)
ohne Wiederholung.
>
> "Die Anzahl möglicher Permutationen ist:
> (n)s = n!/(n-s)! wobei n=10 und s=8. Das ergibt immerhin 1,814,400
> Permutationen."
Die Formel ist schon richtig, aber halt nicht für Permutationen, sondern
für die Variationen. Für Permutationen gilt P(n) = n! (n Fakultät)
(bei n=10 sind das "nur" 3628800.
> Genau! Mit den obigen Beispielen sollte es jetzt vielleicht ein
> bisschen klarer sein.... Bis bald ;-)
>
> gruss
> paddy
>
Gruss
Jens
Paddy
> Ja, hast du. Was du suchst, sind nicht
> Permutationen (mögliche Anordnungen einer endlichen Menge von Zahlen),
> sondern
> Variationen (Auswahl von s Elementen aus einer Menge von n Elementen)
> ohne Wiederholung.
ich habe den gesuchten Sachverhalt mit Permutationen beschrieben, weil
ich diese Definition im Buch "C/C++ - das umfassende Lehrbuch"
entsprechend so gefunden habe. Die Autoren sind Dr. Ulrich Kaiser
(Professor für Informatik) und Christoph Kecher (Software-Ingenieur).
Die wissen das mit Sicherheit viel besser als ich und vielleicht auch
ein bisschen besser als Jens Wanke.
In dem Buch ist von "10-10 Permutationen ohne Wiederholungen" (das ist
das, was mein Code bereits macht und von Jens Wanke ebenfalls als
"Permutation" bezeichnet wird) und von "10-8 Permutationen ohne
Wiederholungen" (das ist das was ich so verzweifelt suche und noch
immer nicht gefunden habe und von Jens Wanke als "Variationen"
bezeichnet wird) die Rede.
Mir ist eigentlich "Wurscht" ob wir den gesuchten Sachverhalt nun als
"Variationen" oder als "10-8 Permutationen" bezeichnen. Auf jeden Fall
ist mittlerweile klar geworden, was ich suche.
Alle weiterführenden Erklärungen, die Andreas Stoye weiter oben
dargelegt hat, sind aus meiner Sicht korrekt und entsprechen genau dem
was ich suche. Möglicherweise verbirgt sich in seiner Formel auch
bereits die Lösung, die man irgendwie in den VBA-Code übernehmen
könnte. Bloss wie und wo?
Des Rätsels Lösung ist also noch immer offen! Ich warte gespannt auf
weitere Anregungen.
Besten Dank und viele Grüsse
paddy
Klaus "Perry" Pago
"Paddy" <klau...@bluewin.ch> schrieb im Newsbeitrag
news:1157999048.7...@d34g2000cwd.googlegroups.com...
> Des Rätsels Lösung ist also noch immer offen! Ich warte gespannt auf
> weitere Anregungen.
dann mal mit Brute Force im Spaghetti-Code
Sub perm_10_8()
a = 1
For i0 = 0 To 9
For i1 = 0 To 9
For i2 = 0 To 9
For i3 = 0 To 9
For i4 = 0 To 9
For i5 = 0 To 9
For i6 = 0 To 9
For i7 = 0 To 9
If i7 = i6 Then GoTo w7
If i7 = i5 Then GoTo w7
If i7 = i4 Then GoTo w7
If i7 = i3 Then GoTo w7
If i7 = i2 Then GoTo w7
If i7 = i1 Then GoTo w7
If i7 = i0 Then GoTo w7
If i6 = i5 Then GoTo w6
If i6 = i4 Then GoTo w6
If i6 = i3 Then GoTo w6
If i6 = i2 Then GoTo w6
If i6 = i1 Then GoTo w6
If i6 = i0 Then GoTo w6
If i5 = i4 Then GoTo w5
If i5 = i3 Then GoTo w5
If i5 = i2 Then GoTo w5
If i5 = i1 Then GoTo w5
If i5 = i0 Then GoTo w5
If i4 = i3 Then GoTo w4
If i4 = i2 Then GoTo w4
If i4 = i1 Then GoTo w4
If i4 = i0 Then GoTo w4
If i3 = i2 Then GoTo w3
If i3 = i1 Then GoTo w3
If i3 = i0 Then GoTo w3
If i2 = i1 Then GoTo w2
If i2 = i0 Then GoTo w2
If i1 = i0 Then GoTo w1
Cells(a, 1) = Str(i0) & Str(i1) & _
Str(i2) & Str(i3) & Str(i4) & Str(i5) _
& Str(i6) & Str(i7)
a = a + 1
w7:
Next i7
w6:
Next i6
w5:
Next i5
w4:
Next i4
w3:
Next i3
w2:
Next i2
w1:
Next i1
Next i0
End Sub
Liefert die gewünschten Permutationen bis Zeile 65536 mit 0 4 3 1 2 6 7 5
Man müsste mehrere Spalten füllen - das könnte man über die Variable "a"
steuern.
Gruß
Klaus
Jens Warnke
> Hallo Zusammen
>
>> Ja, hast du. Was du suchst, sind nicht
>> Permutationen (mögliche Anordnungen einer endlichen Menge von Zahlen),
>> sondern
>> Variationen (Auswahl von s Elementen aus einer Menge von n Elementen)
>> ohne Wiederholung.
>
> ich habe den gesuchten Sachverhalt mit Permutationen beschrieben, weil
> ich diese Definition im Buch "C/C++ - das umfassende Lehrbuch"
> entsprechend so gefunden habe. Die Autoren sind Dr. Ulrich Kaiser
> (Professor für Informatik) und Christoph Kecher (Software-Ingenieur).
> Die wissen das mit Sicherheit viel besser als ich und vielleicht auch
> ein bisschen besser als Jens Wanke.
>
> paddy
>
Tach Paddy,
mal ein bissel Nachhilfe für den Informatik-Professor und den
Software-Ing: http://de.wikipedia.org/wiki/Kombinatorik
Gruß
Jens Warnke
Mathelehrer a.D.
Paddy
Dein Spaghetti-Code sieht auf den ersten Blick vielversprechend aus.
Hab jetzt leider zu wenig Zeit, das auszuprobieren. Muss ich wohl aufs
Wochenende schieben. Rühr mich dann nochmals... Aber auf jeden Fall
besten Dank!
gruss
paddy
Paddy
> mal ein bissel Nachhilfe für den Informatik-Professor und den
> Software-Ing
Also wenn mir die beiden mal über den Weg laufen sollten, denen würd
ich ja was erzählen... Gottseidank kenn' ich die nicht persönlich ;-)
Aber danke für Deine aufschlussreichen Erläuterungen. Man lernt ja
nie aus!
gruss
paddy
Michael Schwimmer
"Paddy" schrieb:
> In dem Buch ist von "10-10 Permutationen ohne Wiederholungen" (das
> ist das, was mein Code bereits macht und von Jens Wanke ebenfalls als
> "Permutation" bezeichnet wird) und von "10-8 Permutationen ohne
> Wiederholungen" (das ist das was ich so verzweifelt suche und noch
> immer nicht gefunden habe und von Jens Wanke als "Variationen"
> bezeichnet wird) die Rede.
>
> Mir ist eigentlich "Wurscht" ob wir den gesuchten Sachverhalt nun als
> "Variationen" oder als "10-8 Permutationen" bezeichnen. Auf jeden
> Fall ist mittlerweile klar geworden, was ich suche.
> Des Rätsels Lösung ist also noch immer offen! Ich warte gespannt auf
> weitere Anregungen.
probiers mal so:
Option Explicit
Private mcolErg As Collection
Private Sub Start()
Set mcolErg = New Collection
Kombi "0123456789", 8
MsgBox "Kombinationen : " & mcolErg.Count
End Sub
Private Function Kombi( _
ByVal strK As String, lngN As Long, _
Optional ByVal intPos As Long _
) As Boolean
Dim strDummy As String
Dim strAct As String
Dim strLeft As String
Dim strRight As String
Dim strRest As String
Dim strBefore As String
Dim i As Long
Dim k As Long
On Error Resume Next
If lngN > Len(strK) Then lngN = Len(strK)
' Wenn die letzte Rekursionsebene erreicht ist,
If intPos = Len(strK) Then
' Doppelte Kombinationen vermeiden
mcolErg.Add Left(strK, lngN), Left(strK, lngN)
Exit Function
Else
' Zeichenfolge vom vorherigem Aufruf ermitteln
strBefore = Left(strK, intPos)
' restliche Ziffern extrahieren
strDummy = Mid(strK, intPos + 1)
k = Len(strDummy)
For i = 1 To k
strLeft = "": strRight = ""
strAct = Mid(strDummy, i, 1)
If i > 1 Then strLeft = Left(strDummy, i - 1)
If i < k Then strRight = Mid(strDummy, i + 1)
' Zeichenkette neu zusammensetzen
strRest = strAct & strLeft & strRight
' diese Funktion rekursiv aufrufen, vorher aber
' Positionszähler um 1 erhöhen
If Kombi(strBefore & strRest, lngN, intPos + 1) = True Then
Kombi = True
Exit Function
End If
Next
End If
End Function
MfG
Michael
--
Michael Schwimmer http://michael-schwimmer.de
Excel VBA ISBN 3-8273-2183-2
Excel Programmierung - Das Handbuch ISBN 3-8606-3548-4