Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1288to1292
1288to1292
Aktuelles Verzeichnis
Verzeichnis Übersicht
Verzeichnis Übersicht
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Kombinationen ausgeben

Forumthread: Kombinationen ausgeben

Kombinationen ausgeben
05.12.2012 00:09:17
Uppe
Hallo Experten,
ich habe 6 Kugeln, die ich auf 4 Schalen verteilen soll. Die Fragen sind:
Wieviele Möglichkeiten der Verteilung gibt es?
Bei wievielen Möglichkeiten davon bleibt mindestens eine Schale leer?
Für die Kombination 6 in 4 habe ich es zu Fuß ausprobiert und 84 und 10 herausbekommen.
Gibt es in Excel eine Möglichkeit, so etwas mit Bordmitteln auszugeben? Oder muß ich mir ein Makro basteln?
Danke und Gruß
Uppe

Anzeige

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Kombinationen ausgeben
05.12.2012 09:14:09
Klaus
Hi,
ich komme bei 6 Kugeln in 4 Schalen auf folgende Kombinationen:
Das sind aber nur 54, und bei immerhin 44 davon ist eine Schale leer.
6 0 0 0
5 1 0 0
4 1 1 0
3 2 0 1
3 2 1 0
1 4 1 0
0 3 2 1
0 3 1 2
2 2 2 0
1 3 1 1
0 2 3 1
0 2 2 2
2 0 3 1
1 1 3 1
1 0 3 2
0 1 1 4
3 1 1 1
2 2 1 1
1 1 2 2
1 1 1 3
2 1 2 1
1 2 1 2
1 1 0 4
5 0 1 0
0 1 3 2
0 1 2 3
3 1 2 0
1 2 2 1
1 2 0 3
0 2 1 3
2 0 2 2
0 1 0 5
4 2 0 0
1 3 2 0
3 0 2 1
2 3 1 0
4 0 2 0
2 1 3 0
2 1 1 2
2 2 0 2
0 1 4 1
0 0 2 4
0 0 0 6
5 0 0 1
4 1 0 1
2 3 0 1
1 2 3 0
1 0 1 4
1 0 0 5
1 0 2 3
0 2 0 4
0 0 1 5
4 0 1 1
1 3 0 2
Ich hab das ganze mit Excel Bordmitteln gelöst, Datei hänge ich an. Geht bis 10 Kugeln in 10 Schalen, ich glaub dadrüber wirds auch zuviel. Da auf VBA verzichtet werden sollte, habe ich das ganze etwas größer anlegen müssen. Die Formeln so weit wie nötig nach unten ziehen (gekürtzt für den Upload), ein paar Tausend Zeilen für den Anfang. Die Kombinationen wiederholen sich, per Formel zähle ich ob es die Kombination schon gab (so bilde ich die Einzigartig-Summe).
Links sind alle Kombinationen für eindeutige Kugeln angebeben und ausgerechnet (ergibt 192 zu 120 Kombinationen), daraus rechne ich rechts die Anzahl Kugeln pro Schale.
https://www.herber.de/bbs/user/82896.xlsx
Grüße,
Klaus M.vdT.

Anzeige
AW: Kombinationen ausgeben
05.12.2012 09:43:38
Uppe
Hallo Klaus,
vielen Dank für Deine Gedanken. Bei Deiner Aufstellung fehlen noch Kombinationsmöglichkeiten, wie z.B. 4002 oder 3300 u.a.
Aber es gibt mir schon mal ein paar Denkanstöße wie es realisierbar wäre.
Gruß Uppe

AW: Kombinationen ausgeben
05.12.2012 10:49:18
bst
Auch Hallo,
Du hast da Kombinationen mit Wiederholung mit n=4 und k=6.
Siehe http://de.wikipedia.org/wiki/Abz%C3%A4hlende_Kombinatorik
Das ergibt (n + k - 1) über (k) hier also (4 + 6 -1) über (6) = 9 über 6 = 9*8*7 / (1*2*3) = 84 Möglichkeiten.
Um die zu erzeugen kannst Du im einfachsten Fall 6 Schleifen von 1...4 verschachteln und doppelte Ergebnisse raus werfen.
Übrigens, nur 10 Möglichkeiten hier haben keine leere Schale.
cu, Bernd
--
Option Explicit
Sub x()
Dim a%, b%, c%, d%, e%, f%, ar(1 To 4), i%
Dim objDic As Object
Set objDic = CreateObject("scripting.dictionary")
For a = 1 To 4
For b = 1 To 4
For c = 1 To 4
For d = 1 To 4
For e = 1 To 4
For f = 1 To 4
For i = 1 To 4: ar(i) = 0: Next
ar(a) = ar(a) + 1
ar(b) = ar(b) + 1
ar(c) = ar(c) + 1
ar(d) = ar(d) + 1
ar(e) = ar(e) + 1
ar(f) = ar(f) + 1
objDic(Join(ar, "-")) = 0
Next
Next
Next
Next
Next
Next
With Cells(1, 1).Resize(objDic.Count)
.Value = WorksheetFunction.Transpose(objDic.Keys)
End With
objDic.RemoveAll
Set objDic = Nothing
End Sub

Anzeige
Danke!
05.12.2012 11:27:24
Uppe
Vielen Danke, Bernd!
Genau das ist es. Wird zwar für eine größere Anzahl Elemente eine ziemliche Schreibarbeit, aber es funzt super!
Gruß Uppe

AW: Danke!
05.12.2012 11:56:09
bst
Nochmals Hallo,
wenn Du das unabhängig von n und k brauchst lässt sich das auch machen.
Dieses hier - aus einer 'Sammlung' kopiert ;-) - erstellt z.B. die Liste der gezogenen Topf-Nummern in Spalte A.
Um daraus die Anzahl der Kugel je Topf zu erhalten müsste man den Code anpassen oder aber danach einfach noch Excel-Formeln benutzen:
B1: =LÄNGE($A1)-LÄNGE(WECHSELN($A1;SPALTE(A1);""))
nach B1:E84 kopieren.
HTH, Bernd
--
Option Explicit
Private Const strDigits As String = "1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Sub KombinationenMitZuruecklegenString(ByVal n As Integer, ByVal k As Integer)
Dim ar() As String, lngSize As Long, s As String, i As Long
lngSize = WorksheetFunction.Combin(n - 1 + k, k)
ReDim ar(1 To lngSize, 1 To 1)
s = String(k, Left(strDigits, 1))
ar(1, 1) = s
For i = 2 To lngSize
ar(i, 1) = strIncRisingOrEqual(s, n, k, k)
Next
Range("A1").Resize(lngSize) = ar
End Sub


Function strIncRisingOrEqual(ByRef s As String, ByVal n As Integer, ByVal k As Integer, ByVal  _
intSpalte As Integer) As String
Dim intVal As Integer, i As Integer
intVal = InStr(1, strDigits, Mid(s, intSpalte, 1), vbTextCompare)
If intVal 

Sub Main()
Dim n As Integer, k As Integer, t As Single
n = 4
k = 6
t = Timer
KombinationenMitZuruecklegenString n, k
Debug.Print "String", Timer - t
End Sub

Anzeige
AW: Danke!
05.12.2012 12:32:53
Uppe
Perfekt!
Ich liebe dieses Forum!
Danke und Gruß
Uppe

AW: Kombinationen ausgeben, noch eine
05.12.2012 13:09:09
Rudi
Hallo,
so geht's auch.
Man muss ja nur für alle Zahlen zwischen 6 und 6000 die Quersumme bilden 
Sub Kugel_legen()
Dim iSchalen As Integer, iKugeln As Integer
Dim i, j, objErg As Object, iTest As Long, strTest As String, strKombi As String
Set objErg = CreateObject("Scripting.Dictionary")
iSchalen = 4
iKugeln = 6
For i = iKugeln To iKugeln * 10 ^ (iSchalen - 1)
iTest = 0
strKombi = ""
strTest = Format(i, String(iSchalen, "0"))
'Quersumme
For j = 1 To Len(strTest)
strKombi = strKombi & Mid(strTest, j, 1) & "-"
iTest = iTest + Mid(strTest, j, 1) * 1
Next
If iTest = iKugeln Then
objErg(strTest) = Left(strKombi, 2 * iSchalen - 1)
End If
Next
With Sheets(1)
.Columns(1).Clear
.Cells(1, 1).Resize(objErg.Count) = WorksheetFunction.Transpose(objErg.items)
End With
End Sub

Gruß
Rudi

Anzeige
geht aber nur bis 9. owT
05.12.2012 14:03:36
Rudi
;

Beliebteste Forumthreads (12 Monate)

Jetzt das Excel-Portal bewerten: Deine Stimme zählt!
Anzeige
Anzeige
Anzeige