Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1100to1104
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

alle Varianten erzeugen

alle Varianten erzeugen
Peter
Hallo Excel-Experten,
ich möchte die Zahlen 1 bis 5 sooft mischen, wie möglich, wobei aber auch alle bis auf eine Zahl fehlen können.
Also nur vorhanden z. B. 1 alleine, 2 alleine, aber auch nur 1 und 5, 1 und 4, 1 und 3, 2 und 5, 2 und 4 und 5, 1 und 3 und 5 usw.
Ich weiß nicht recht, unter welchem Stichwort ich suchen könnte. Kombinatorik hat nichts rechtes erbracht.
Kennt jemand ein Makro, das diese Anforderungen erfüllt?
Gruß Peter
Permutationen ohne Wiederholung auflisten
04.09.2009 10:15:36
WF
Hi Peter,
natürlich per Formel - wer benutzt schon VBA?
http://www.excelformeln.de/formeln.html?welcher=325
bei 1 2 3 4 5 gibt das also 120 Möglichkeiten
"... wobei aber auch alle bis auf eine Zahl fehlen können"
Mir ist nicht klar, was Du damit ausdrücken möchtest?
Bei Permutationen MIT Wiederholung mußt Du also fummeln - ist bei uns nicht vorrätig.
Salut WF
AW: Permutationen ohne Wiederholung auflisten
04.09.2009 10:38:19
Peter
Hallo WF,
meine manuelle Aufzählung der Möglichkeiten sieht bisher so aus:
1 2 3 4 5
1 2 3 4
1 2 3
1 2
1
2 3 4 5
2 3 4
2 3
2
3 4 5
3 4
3
4 5
4
1 5
1 4
1 3
1 4 5
1 3 4 5
1 2 4 5
1 2 4
1 2 5
1 3 4
1 3 5
2 3 5
2 4 5
2 4
2 5
3 5
Ich nehme an, mir fehlen da einige Möglichkeiten.
Gruß Peter
Anzeige
AW: Permutationen ohne Wiederholung auflisten
04.09.2009 11:10:35
JogyB
Hi.
Wenn ich ihn richtig verstanden habe will er alle Kombinationen der Zahlen 1 bis 5 ohne Zurücklegen und ohne Anordnung. Und das für 1 bis 5 Ziehungen. Wenn ich mich nicht verrechnet habe sind das 31 Möglichkeiten.
Probier es mal so:
' Gibt alle Kombinationen von n Ziehungen von maxNum Zahlen ohne Zurücklegen
' und ohne Anordnung
' Bei nicht sinnvollen Kombinationen wird FALSE zurückgegeben
Function Mischen(ByVal maxNum As Long, ByVal zieHungen As Long) As Variant
Dim i As Long
Dim k As Long
Dim l As Long
Dim ergArr() As String
Dim tempArr() As String
Dim tempStr As String
If zieHungen > maxNum Then
' Alternativ Fehlerwert (hinter Kommentar)
Mischen = False 'CVErr(xlErrValue)
Exit Function
End If
ReDim tempArr(0)
ReDim ergArr(1 To maxNum)
' In erster Ziehung können prinzipiell alle Zahlen kommen
' werden evtl. wieder verworfen
For i = 1 To 5
ergArr(i) = i
Next
' Ab zweiter Ziehung
For i = 2 To zieHungen
' Alle Ergebnisse aus erster Ziehung verwenden
For k = 1 To UBound(ergArr)
' Da "ohne Zurücklegen, ohne Anordnung" kann alles in
' stetig aufsteigende Zahlenfolgen überführt werden
For l = Right(ergArr(k), 1) + 1 To maxNum
If UBound(tempArr) = 0 Then
ReDim tempArr(1 To 1)
Else
ReDim Preserve tempArr(1 To UBound(tempArr) + 1)
End If
tempArr(UBound(tempArr)) = ergArr(k) & l
Next
Next
' tempArr ist der neue Ergebnis-Array
ergArr = tempArr
' Alten Ergebnis-Array zurücksetzen
ReDim tempArr(0)
Next
Mischen = ergArr
End Function
' Gibt die Ergebnisse für alle Ziehungslängen von 1 bis maxZiehungen aus
Sub alleMischungen()
Dim i As Long
Dim k As Long
Dim erGebnis
Dim schrZeile As Long
Const maxZahl = 5
Const maxZiehungen = 5
If maxZiehungen > maxZahl Then Exit Sub
Application.ScreenUpdating = False
schrZeile = 1
For i = 1 To maxZiehungen
erGebnis = Mischen(maxZahl, i)
For k = 1 To UBound(erGebnis)
ActiveSheet.Cells(schrZeile, 1).Value = erGebnis(k)
schrZeile = schrZeile + 1
Next
Next
Application.ScreenUpdating = True
End Sub
Gruss, Jogy
Anzeige
Fehler...
04.09.2009 11:26:53
JogyB
Hi.
Da ist ein kleiner Fehler drin:
Das
For i = 1 To 5
mußt Du durch
For i = 1 To maxNum
ersetzen.
Macht bei Dir jetzt nichts aus, wenn Du aber mal andere Zahlen verwendest, gibt das ein Problem.
Gruss, Jogy
Und so auch für mehrstellige Zahlen...
04.09.2009 11:34:11
JogyB
Hi.
Die Mischen-Funktion hat so nur für einstellige Zahlen funktioniert, so ist es allgemeiner:
' Gibt alle Kombinationen von n Ziehungen von maxNum Zahlen ohne Zurücklegen
' und ohne Anordnung
' Bei nicht sinnvollen Kombinationen wird FALSE zurückgegeben
Function Mischen(ByVal maxNum As Long, ByVal zieHungen As Long) As Variant
Dim i As Long
Dim k As Long
Dim l As Long
Dim ergArr() As String
Dim tempArr() As String
Dim tempStr As String
If zieHungen > maxNum Then
' Alternativ Fehlerwert (hinter Kommentar)
Mischen = False 'CVErr(xlErrValue)
Exit Function
End If
ReDim tempArr(0)
ReDim ergArr(1 To maxNum)
' In erster Ziehung können prinzipiell alle Zahlen kommen
' werden evtl. wieder verworfen
For i = 1 To maxNum
ergArr(i) = i
Next
' Ab zweiter Ziehung
For i = 2 To zieHungen
' Alle Ergebnisse aus erster Ziehung verwenden
For k = 1 To UBound(ergArr)
' Da "ohne Zurücklegen, ohne Anordnung" kann alles in
' stetig aufsteigende Zahlenfolgen überführt werden
For l = Split(ergArr(k), " ")(i - 2) + 1 To maxNum
If UBound(tempArr) = 0 Then
ReDim tempArr(1 To 1)
Else
ReDim Preserve tempArr(1 To UBound(tempArr) + 1)
End If
tempArr(UBound(tempArr)) = ergArr(k) & " " & l
Next
Next
' tempArr ist der neue Ergebnis-Array
ergArr = tempArr
' Alten Ergebnis-Array zurücksetzen
ReDim tempArr(0)
Next
Mischen = ergArr
End Function

Gruss, Jogy
Anzeige
AW: Permutationen ohne Wiederholung auflisten
04.09.2009 11:33:54
Peter
Hallo Jogy,
danke für Deine Hilfe.
Bis auf eine Variante hatte ich es manuell bereits zusammengestellt bekommen, aber eben nicht als Makro.
Hier handelt es sich nicht um eine 'Ziehung', sondern um eine Auswahl von 5 TextBoxes, die je nach Auswahl in einer ComboBox Visible oder nicht Visible sein sollen.
Gruß Peter
AW: Permutationen ohne Wiederholung auflisten
04.09.2009 11:36:53
JogyB
Hi.
Was nachher damit gemacht wird ist egal, aus kombinatorischer Sicht sind es Ziehungen ;).
Gruss, Jogy
AW: Permutationen ohne Wiederholung auflisten
04.09.2009 11:41:46
Peter
Hij Jogy,
Du hast ja sooo Recht - danke auch für die Korrektur.
Gruß Peter
AW: Permutationen ohne Wiederholung auflisten
04.09.2009 11:54:41
JogyB
Und weil es grade so Spaß macht:
Hier noch eine Variante, bei der keine Zwischenergebnisse verworfen werden müssen:
' Gibt alle Kombinationen von n Ziehungen von maxNum Zahlen ohne Zurücklegen
' und ohne Anordnung
' Bei nicht sinnvollen Kombinationen wird FALSE zurückgegeben
Function Mischen(ByVal maxNum As Long, ByVal zieHungen As Long) As Variant
Dim i As Long
Dim k As Long
Dim l As Long
Dim ergArr() As String
Dim tempArr() As String
Dim tempStr As String
Const trennZ = " "
If zieHungen > maxNum Then
' Alternativ Fehlerwert (hinter Kommentar)
Mischen = False 'CVErr(xlErrValue)
Exit Function
End If
ReDim tempArr(0)
ReDim ergArr(1 To maxNum - zieHungen + 1)
' Da es sich auf eine austeigende Folge zurückführen läßt,
' können nur Anfangszahlen vorkommen, die auch Platz für
' diese Folge lassen
For i = 1 To maxNum - zieHungen + 1
ergArr(i) = i
Next
' Ab zweiter Ziehung
For i = 2 To zieHungen
' Alle Ergebnisse aus erster Ziehung verwenden
For k = 1 To UBound(ergArr)
' Da "ohne Zurücklegen, ohne Anordnung" kann alles in
' stetig aufsteigende Zahlenfolgen überführt werden
' wie oben brauchen nur Zahlen verwendet werden, die dann auch Platz
' für die weitere Folge lassen, es geht also bis maxNum - (Anzahl folgender Ziehungen)
For l = Split(ergArr(k), trennZ)(i - 2) + 1 To maxNum - zieHungen + i
If UBound(tempArr) = 0 Then
ReDim tempArr(1 To 1)
Else
ReDim Preserve tempArr(1 To UBound(tempArr) + 1)
End If
tempArr(UBound(tempArr)) = ergArr(k) & trennZ & l
Next
Next
' tempArr ist der neue Ergebnis-Array
ergArr = tempArr
' Alten Ergebnis-Array zurücksetzen
ReDim tempArr(0)
Next
Mischen = ergArr
End Function
Tut der Laufzeit bei großen Zahlen gut.
Gruss, Jogy
Anzeige
AW: Permutationen ohne Wiederholung auflisten
04.09.2009 20:29:37
Peter
Hij Jogy,
auch für diese Version vielen Dank.
Ich war aber bereits mit Deinen vorhergegangenen Makros mehr als 'glücklich', zumal es sich bei der Anwendung, für die ich es benötigt habe um eine einmalige Anwendung für einen guten Bekannten von uns handelt, die nun gelöst werden konnte - alles Varianten sind in der geforderten ComboBox enthalten.
Gruß und ein wunderschönes Wochenende
Peter

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige