Microsoft Excel

Herbers Excel/VBA-Archiv

Kombinationen mit Zurücklegen ohne Reihenfolge

Betrifft: Kombinationen mit Zurücklegen ohne Reihenfolge von: Christian
Geschrieben am: 11.08.2008 22:53:34

Hallo zusammen,
ich suche eine VBA Lösung für folgende Aufgabe:
Gezogen werden "k" Kugeln aus einer Los-Trommel. Die Trommel enthält "n" Kugeln. Die gezogenen Kugeln werden anschließend zurückgelegt. Gesucht sind die möglichen Kombinationen der Ziehungen. Dabei kommt es nicht auf die Reihenfolge an.

Es kann sowohl k>n als auch n>k sein.

also z. Bsp für k=3, n=3:
1, 1, 1
1, 1, 2
1, 2, 2
1, 1, 3
1, 3, 3
1, 2, 3
2, 2, 2
2, 2, 3
2, 3, 3
3, 3, 3

Bei meinen Recherchen habe ich einen Code von Bernd (bst) mir Rekursion gefunden. Dieser sieht schon sehr vielversprechend aus, aber leider kann ich diesen mit meinen Kenntnissen nicht entsprechend anpassen.

http://www.online-excel.de/fom/fo_read.php?f=1&bzh=-1&h=24953&ao=1

vielen Dank vorab für eure Hilfe
Grüße
Christian

  

Betrifft: AW: Kombinationen mit Zurücklegen ohne Reihenfolge von: bst
Geschrieben am: 12.08.2008 08:35:26

Morgen Christian,

HTH, Bernd
--

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Sub KombinationenMitZuruecklegenArray(ByVal n As Integer, ByVal k As Integer)
    Dim ar As Variant, i As Long, j As Integer, lngSize As Long
    
    lngSize = WorksheetFunction.Combin(n - 1 + k, k)
    Redim ar(1 To lngSize, 1 To k)
    
    For j = 1 To k
        ar(1, j) = 1 ' ar(1, j) = 0 ' um ab 0 zu zählen
    Next
    
    For i = 2 To lngSize
        For j = 1 To k
            ar(i, j) = ar(i - 1, j)
        Next
        arInc ar, i, n, k, k ' arInc ar, i, n - 1, k, k ' um ab 0 zu zählen
    Next
    Range("A1").Resize(lngSize, k) = ar
End Sub

Sub arInc(ByRef ar As Variant, ByVal i As Long, ByVal n As Integer, ByVal k As Integer, ByVal intSpalte As Integer)
    Dim intVal As Integer, j As Integer
    
    If ar(i, intSpalte) < n Then
        intVal = ar(i, intSpalte) + 1
        For j = intSpalte To k
            ar(i, j) = intVal
        Next
    Else
        arInc ar, i, n, k, intSpalte - 1
    End If
End Sub

Sub TestIt()
    Dim n As Integer, k As Integer, t As Single
    
    n = 3
    k = 3
    
    t = Timer
    KombinationenMitZuruecklegenArray n, k
    Debug.Print "Array", Timer - t
End Sub



  

Betrifft: als Formel von: WF
Geschrieben am: 12.08.2008 08:39:34

Hi Christian,

n in A1 und k in B1
=FAKULTÄT(A1+B1-1)/(FAKULTÄT(B1)*FAKULTÄT(A1-1))

Und k kann NIE größer n sein.

Salut WF


  

Betrifft: AW: als Formel von: bst
Geschrieben am: 12.08.2008 08:42:20

Hi,

"Und k kann NIE größer n sein."

Hier doch. Die Kugeln werden ja wieder zurückgelegt.

Man kann als schon 5 Mal aus 3 Kugeln ziehen :-)

cu, Bernd


  

Betrifft: AW: als Formel von: Erich G.
Geschrieben am: 12.08.2008 09:25:19

Hi Bernd,
was ist k? Die Anzahl Ziehungen? Christian schreibt richtig:
"Gezogen werden "k" Kugeln aus einer Los-Trommel. Die Trommel enthält "n" Kugeln."

Versuch mal, 5 Kugeln aus einer Trommel zu nehmen, die nur 4 Kugeln enthält... ;-))

Ich denke, Walter liegt da schon richtig.

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: als Formel von: bst
Geschrieben am: 12.08.2008 09:40:38

Hi Erich,

Du kannst auch 1 Mio mal ziehen.

Der Gag ist ja der, dass die gezogene Kugel nach dem Ziehen wieder zurückgelegt wird!!!

D.h. bei jeder Ziehung, egal der wie vielten das ist, liegen immer k Kugeln im Topf.

cu, Bernd


  

Betrifft: AW: Bernd hat recht von: Erich G.
Geschrieben am: 12.08.2008 10:16:46

Hi Bernd,
Kommando zurück - k kann größer als n sein, da hast du recht!
(Und mein VBA-Vorschlag erzeugt auch die Liste...)

Bsp. für k=4, n=3 (Anzahl verschiedene Kombis: 15; (n+k-1) über k
1111
1112
1113
1122
1123
1133
1222
1223
1233
1333
2222
2223
2233
2333
3333

Grüße von Erich aus Kamp-Lintfort


  

Betrifft: AW: Kombinationen mit Zurücklegen ohne Reihenfolge von: Reinhard
Geschrieben am: 12.08.2008 08:44:08

Moin Christian,

ich habe mich auch daran versucht:

Option Explicit
'
Sub tt()
Dim A, k, n, colC As New Collection, C, Z(1 To 3), strC, t As Single
Application.ScreenUpdating = False
k = 3
n = 3
t = Timer
A = Anz(k, n)
On Error Resume Next
While colC.Count < A
   For n = 1 To 3
      Z(n) = Int(Rnd() * 3) + 1
   Next n
   strC = ""
   For n = 1 To 3
      strC = strC & Application.WorksheetFunction.Small(Array(Z(1), Z(2), Z(3)), n)
   Next n
   colC.Add Item:=strC, key:=strC
Wend
For n = 1 To colC.Count
   Cells(n, 1) = colC(n)
Next n
Columns(1).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A").Select
Debug.Print Timer - t
Application.ScreenUpdating = True
End Sub
'
Function Anz(k, n)
Anz = F(n + k - 1) / F(k) / F(n - 1)
End Function
'
Function F(ByVal Zahl)
F = Application.WorksheetFunction.Fact(Zahl)
End Function


Gruß
Reinhard


  

Betrifft: AW: Kombinationen mit Wiederholung von: Erich G.
Geschrieben am: 12.08.2008 09:27:59

Hallo Christian,
probier mal

Option Explicit

Sub test()
   Dim n As Integer, k As Integer, ii As Integer, tt As String, zz As Long
   n = 9
   k = 4
   
   For ii = 1 To n
      tt = tt & Chr(ii - 1 + Asc("1"))  ' Zeichenvorrat
   Next ii

   zz = 2         ' Startzeile
   Application.ScreenUpdating = False
          ' 1 steht für "mit Widerholung" (0 für "ohne")
          '                      3 ist die Tabellenspalte
   Komb_omW 1, tt, n, k, "", zz, 3
   Application.ScreenUpdating = True
End Sub

Sub Komb_omW(Wied As Boolean, txt As String, Anz As Integer, _
   ELen As Integer, Erg As String, Ze As Long, Sp As Long)
   Dim ii As Integer, Laenge As Integer, jj As Integer, iO As Boolean

   Laenge = Len(Erg)
   For ii = 1 To Anz
      If Laenge < ELen - 1 Then
         iO = True
         For jj = 1 To Len(Erg)
            If Mid(txt, ii, 1) < Mid(Erg, jj, 1) Then iO = False: Exit For
            If Not Wied And _
               Mid(txt, ii, 1) = Mid(Erg, jj, 1) Then iO = False: Exit For
         Next jj
         If iO Then _
            Komb_omW Wied, txt, Anz, ELen, Erg & Mid(txt, ii, 1), Ze, Sp
      Else
         iO = True
         For jj = 1 To Len(Erg)
            If Mid(txt, ii, 1) < Mid(Erg, jj, 1) Then iO = False: Exit For
            If Not Wied And _
               Mid(txt, ii, 1) = Mid(Erg, jj, 1) Then iO = False: Exit For
         Next jj
         If iO Then
            Cells(Ze, Sp) = Erg & Mid(txt, ii, 1) ' <-- Ausgabe
            Ze = Ze + 1
            If Ze >= Rows.Count - 2 Then Exit Sub
         End If
      End If
   Next ii
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort


  

Betrifft: Danke an alle! von: Christian
Geschrieben am: 12.08.2008 14:34:35

Hallo zusammen,
vielen Dank für die Lösungen. Bernd hat das Thema "Zurücklegen" richtig verstanden. Jede gezogene Kugel wird vor dem nächsten Zug zurückgelegt. Daher kann auch "k" größer "n" sein. Meine ursprüngliche Formulierung war vielleicht nicht ganz eindeutig.

Die Lösung von Bernd gefällt mir am Besten, wobei die anderen nätürlich genauso gut funktionieren. Aber ich glaube, dass die String-Operationen mehr Rechenzeit benötigen.

Ihr habt mir sehr geholfen.
viele Grüße
Christian


 

Beiträge aus den Excel-Beispielen zum Thema "Kombinationen mit Zurücklegen ohne Reihenfolge"