Kombinatorik Makro erweitern

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
InputBox MsgBox
Bild

Betrifft: Kombinatorik Makro erweitern
von: Eco
Geschrieben am: 09.05.2015 10:36:34

Hi,
Ich bin leider am verzweifeln. Deswegen brauche ich bitte Eure Unterstützung.
Folgender cod erstellt aus neun beliebigen Werten welche in B1:B9 Aufgeführt werden alle daraus resultierenden Kombinationen.
Leider langen mir die neun Variablen Werte nicht mehr aus und ich würde das Marco gerne erweitern.
A/ kann mir jemand bitte auf die Sprünge helfen was ich ändern müsste um z.B. die Kombinationen _
für 24 Variablen zu erhalten. Ich habe natürlich mit meinen LeihenhaftenVBA Kenntnissen herum _
experimentiert aber komme zu keinem befriedigenden Ergebnis.


Sub Kombi() 
Dim varZahl(8) As Variant 
Dim loA As Long 
Dim loB As Long 
Dim loC As Long 
Dim loD As Long 
Dim loE As Long 
Dim loF As Long 
Dim loG As Long 
Dim loK As Long 
Dim loJ As Long 
loG = 3 
loK = 1 
loJ = 5 
For loA = 0 To 8 
varZahl(loA) = Cells(loA + 1, 2) 
Next 
For loA = 0 To loG 
    For loB = loA + 1 To loG + 1 
        For loC = loB + 1 To loG + 2 
            For loD = loC + 1 To loG + 3 
                For loE = loD + 1 To loG + 4 
                    For loF = loE + 1 To 8 
                        Cells(loK, loJ) = varZahl(loA) 
                        loJ = loJ + 1 
                        Cells(loK, loJ) = varZahl(loB) 
                        loJ = loJ + 1 
                        Cells(loK, loJ) = varZahl(loC) 
                        loJ = loJ + 1 
                        Cells(loK, loJ) = varZahl(loD) 
                        loJ = loJ + 1 
                        Cells(loK, loJ) = varZahl(loE) 
                        loJ = loJ + 1 
                        Cells(loK, loJ) = varZahl(loF) 
                        loK = loK + 1 
                        loJ = 5 
                    Next 
                Next 
            Next 
        Next 
    Next 
Next 
End Sub

B/ der Königsweg wäre es natürlich wenn es eine Möglichkeit gäbe den Code so variabel zu gestallten das er selbständig alle Zahlen in B:B nimmt. Soll bedeuten einmal stehen hier 15 werte beim nächstenmal 30. Leider weiß ich hier garkeinen Lösungsansatz.
Vielen Dank für Euren Support!
Gruß
Eco

Bild

Betrifft: AW: Kombinatorik Makro erweitern
von: fcs
Geschrieben am: 11.05.2015 07:38:00
Hallo Eco,
hast du schon mal ausgerechnet, wie viele Kombinationen es dann bei größeren Zahlen gibt?
das sprengt schnell den Rahmen jeder Exceltabelle und je nach Programmiergeschickt verschwindet Excel imNirvana oder wenn du Glück hast früh in einem Fehler der das Makro stoppt.
Gruß
Franz

Bild

Betrifft: AW: Kombinatorik Makro erweitern
von: Eco
Geschrieben am: 13.05.2015 12:52:41
Hallo Franz,
vielen Dank für deine Antwort.
Ja, ich habe die möglichen kombinationen bereits berechnet bsp. bei 24 Zahlen liegen wir lediglich bei 134.596 kombinationen. Das wiederrum erscheint mit als machbar.
Weißt Du wir ich das Marco einfach erweitern kann?
Gruß
Thomas

Bild

Betrifft: AW: Kombinatorik Makro erweitern
von: Michael
Geschrieben am: 11.05.2015 16:47:47
Hallo Eco,
vielleicht hilft Dir das hier weiter: http://www.excelformeln.de/formeln.html?welcher=91
Gruß,
Michael

Bild

Betrifft: AW: Kombinatorik Makro erweitern
von: Michael
Geschrieben am: 13.05.2015 17:44:45
Hallo Eco,
es hat mir keine Ruhe gelassen, weil ich schwören hätte können, daß ich da was in meinem Archiv habe - Fehlanzeige!
Aber gut: die Lösung heißt, wie so oft, wenn es um Algorithmen geht, rosettacode: http://rosettacode.org/wiki/Permutations#VBA
Da kopierst Du das Ding raus in Deinen VBA-Editor; ich hab es mal als Code zu Tabelle1 gespeichert und in Tabelle1!A1 4 (für n) und in B1 WAHR oder FALSCH eingegeben.
Aufgerufen wird das Ding z.B. so:

Sub p_aufrufen()
Call Permute(Range("A1").Value, Range("B1").Value)
End Sub
Ich habe diesen Code herausgesucht, weil er *nicht* rekursiv ist. Rekursion ist vielleicht elegant und schön und alles, aber ich mag's nicht, und Speicher kostet es auch ohne Ende.
Die Ausgabe erfolgt hier im Direktfenster, das mußt Du halt anpassen auf Range(irgendwas).
24 habe ich nach 3 Minuten abgewürgt, und bei 10 kommen schon 3.628.800 raus!
Happy Exceling,
Michael

Bild

Betrifft: AW: Kombinatorik Makro erweitern
von: Eco
Geschrieben am: 13.05.2015 21:47:43
Hallo Michael,
VIELEN DANK FÜR DEINE ANTWORT. Ich schätze deine Antwort sehr!
Leider stell ich mich wohl zu dumm an. Es passiert garnichts :-( wenn ich die beiden sub's starte.
Was meinst Du mit "in B1 WAHR oder FALSCH"?
Folgendes habe ich in ein modul geschreiben:
Sub p_aufrufen()
Call Permute(Range("A1").Value, Range("B1").Value)
End Sub

Public Sub Permute(n As Integer, Optional printem As Boolean = True)
'generate, count and print (if printem is not false) all permutations of first n integers
 
Dim P() As Integer
Dim count As Long
Dim Last As Boolean
Dim t, i, j, k As Integer
 
If n <= 1 Then
  Debug.Print "give a number greater than 1!"
  Exit Sub
End If
 
'initialize
ReDim P(n)
For i = 1 To n: P(i) = i: Next
count = 0
Last = False
 
Do While Not Last
 'print?
 If printem Then
   For t = 1 To n: Debug.Print P(t);: Next
   Debug.Print
 End If
 count = count + 1
 
 Last = True
 i = n - 1
 Do While i > 0
   If P(i) < P(i + 1) Then
     Last = False
      Exit Do
   End If
   i = i - 1
 Loop
 
 If Not Last Then
   j = i + 1
   k = n
   While j < k
     ' swap p(j) and p(k)
     t = P(j)
     P(j) = P(k)
     P(k) = t
     j = j + 1
     k = k - 1
   Wend
   j = n
   While P(j) > P(i)
     j = j - 1
   Wend
   j = j + 1
   'swap p(i) and p(j)
   t = P(i)
   P(i) = P(j)
   P(j) = t
 End If 'not last
 
Loop 'while not last
 
Debug.Print "Number of permutations: "; count
 
End Sub

Gemäß deiner Anweisung in Tabellenblatt 1 A:1=4 und B:1=WAHR
Sorry :-)
Gruß
Eco

Bild

Betrifft: AW: Kombinatorik Makro erweitern
von: Michael
Geschrieben am: 14.05.2015 13:20:13
Hallo Eco,
ich habe den Code bewußt nicht ins Forum gestellt, weil ich mich nicht darum kümmern wollte, ob er Public Domain oder mit (c) ist.
Wenn ich was reinstelle, was nicht auf meinem Mist gewachsen ist, bringe ich zumindest anstandshalber einen entsprechenden Hinweis zur Herkunft an.
Sei's drum, jetzt isser schon da, und woher er stammt, erschließt sich ja auch.
Also: ich habe geschrieben, daß die Ausgabe im *Direktfenster* erfolgt. Das hast Du offensichtlich überlesen. Das Direktfenster kann für "schnelle" Ausgaben in VBA verwendet werden. Es wird angezeigt, wenn Du in der VBA-Umgebung Strg+g drückst (oder es übers Menü in VBA öffnest: Ansicht - Direktfenster).
Es passiert also nicht "nichts", sondern die Ausgabe steht dort!
Also: alle debug.print-Anweisungen sind zu ersetzen durch range(xxx)=jeweiliger Wert
Ich hab das mal schnell eingefügt, Datei: https://www.herber.de/bbs/user/97647.xls
Aus Geschwindigkeitsgründen solltest Du *zunächst* bei größeren Zahlen (wie z.B. 10) FALSCH in B1 schreiben, dann werden die Permutationen nicht ausgedruckt, nur die Anzahl, und Du siehst dann schon mal, wie lange das dauert.
Für die Ausgabe im Tabellenblatt habe ich ja die Variable zeile definiert; es könnte Sinn machen, die alle 1000 oder 10000 Schleifendurchgänge mit einer MsgBox (oder inputbox: weitermachen ja/nein) zu versehen, dann kannst Du das Ding wenigstens abbrechen, ohne daß es ins Nirvana läuft.
Schöne Grüße,
Michel

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Kombinatorik Makro erweitern"