6.561 Kombinationen auflisten

Hallo,
ich muss alle Kombinationsmöglichkeiten bei
4 aus 9
auflisten.
Die Berechnung hierfür habe ich dort gefunden:
https://www.zum.de/Faecher/Materialien/gebhardt/stochastik/Kombin.html
Ergebnis: 6.561
Ich habe (evtl. in diesem Forum) vor einiger Zeit einen Code gefunden mit dem das bei entsprechender Änderung gehen könnte; leider habe ich die konkrete Quelle nicht mehr:
Option Explicit
Sub Schaltfläche1_Klicken()
Application.ScreenUpdating = False
Dim z
Dim t As Single
Dim z1 As Integer
Dim z2 As Integer
Dim z3 As Integer
Dim z4 As Integer
Dim z5 As Integer
Dim z6 As Integer
z = 1
t = Timer
For z1 = 1 To 9
For z2 = 1 To 9
For z3 = 1 To 9
For z4 = 1 To 9
For z5 = 1 To 9
For z6 = 1 To 9
Cells(z, 1) = z1
If frei(z2, z, 2) Then
Cells(z, 2) = z2
Else
GoTo weiter2
End If
If frei(z3, z, 3) Then
Cells(z, 3) = z3
Else
GoTo weiter3
End If
If frei(z4, z, 4) Then
Cells(z, 4) = z4
Else
GoTo weiter4
End If
If frei(z5, z, 5) Then
Cells(z, 5) = z5
Else
GoTo weiter5
End If
If frei(z6, z, 6) Then
Cells(z, 6) = z6
z = z + 1
'If (z Mod 30) = 0 Then ActiveWindow.ScrollRow = z - 20
Else
GoTo weiter6
End If
DoEvents
weiter6:
Next z6
weiter5:
Next z5
weiter4:
Next z4
weiter3:
Next z3
weiter2:
Next z2
weiter1:
Next z1
Application.ScreenUpdating = True
MsgBox Str(Timer - t) + " sec."
End Sub

Public Function frei(ByVal zahl As Integer, ByVal z As Long, ByVal pos As Integer) As Boolean
Dim s
frei = True
For s = 1 To pos - 1
If Cells(z, s) = zahl Then frei = False
Next s
End Function

Mir gelingt aber leider die Anpassung nicht.
Ob das evtl. mit einer Formel-Funktion geht weiß ich nicht (würde mir aber auch reichen).
Besten Dank für eine Hilfe.
mfg

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub s() Application.ScreenUpdating = False Dim z Dim t As Single Dim z1 As Integer Dim z2 As Integer Dim z3 As Integer Dim z4 As Integer z = 1 t = Timer For z1 = 1 To 9 For z2 = 1 To 9 For z3 = 1 To 9 For z4 = 1 To 9 Cells(z, 1) = z1 If frei(z2, z, 2) Then Cells(z, 2) = z2 Else GoTo weiter2 End If If frei(z3, z, 3) Then Cells(z, 3) = z3 Else GoTo weiter3 End If If frei(z4, z, 4) Then Cells(z, 4) = z4 z = z + 1 'If (z Mod 30) = 0 Then ActiveWindow.ScrollRow = z - 20 Else GoTo weiter4 End If DoEvents weiter4: Next z4 weiter3: Next z3 weiter2: Next z2 weiter1: Next z1 Application.ScreenUpdating = True MsgBox Str(Timer - t) + " sec." End Sub

Danke - das sind jetzt 3.024 Kombinationen.
Der Unterschied zu den 6.561 gesuchten Kombinationen besteht wohl bei der Berücksichtigung von Wiederholungen. Die genannte Seite
https://www.zum.de/Faecher/Materialien/gebhardt/stochastik/Kombin.html
bietet bei der Berechnung die Möglichkeit mit Wiederholungen und ohne Wiederholungen an. An einem kleinen Beispiel versuche ich den Unterschied zu verdeutlichen:
2 aus 4
mit Wiederholungen = 64
111, 112, 113, 114, 121, 122, 123, 124, 131, 132, 133, 134, 141, 142, 143, 144, 211, 212, 213, 214, 221, 222, 223, 224, 231, 232, 233, 234, 241, 242, 243, 244, 311, 312, 313, 314, 321, 322, 323, 324, 331, 332, 333, 334, 341, 342, 343, 344, 411, 412, 413, 414, 421, 422, 423, 424, 431, 432, 433, 434, 441, 442, 443, 444,
ohne Wiederholungen = 24
123, 124, 132, 134, 142, 143, 213, 214, 231, 234, 241, 243, 312, 314, 321, 324, 341, 342, 412, 413, 421, 423, 431, 432,
Übertragen auf die Anfrage zu 6.561 Kombinationen müsste die 1. Kombination
1111
sein; die 2. Kombination
1112
Kann man das mit EXCEL darstellen / auflisten?
Danke nochmals.
mfg

Sub Schaltfläche1_Klicken() Dim s1, s2, s3, s4, z Cells.ClearContents z = 1 For s1 = 1 To 9 For s2 = 1 To 9 For s3 = 1 To 9 For s4 = 1 To 9 Cells(z, 1) = s1 Cells(z, 2) = s2 Cells(z, 3) = s3 Cells(z, 4) = s4 z = z + 1 Next s4 Next s3 Next s2 Next s1 End Sub

Sub Kombis() Dim Pool1 As String Dim Pool2 As String Dim Pool3 As String Dim Pool4 As String Dim Erg As String Dim Arr Dim z1 As Long, z2 As Long, z3 As Long, z4 As Long Dim ohneWdh As Boolean ohneWdh = False Pool1 = "123456789" Pool2 = Pool1 Pool3 = Pool1 Pool4 = Pool1 For z1 = 1 To Len(Pool1) If ohneWdh Then Pool2 = Replace(Pool1, Mid(Pool1, z1, 1), "") For z2 = 1 To Len(Pool2) If ohneWdh Then Pool3 = Replace(Pool2, Mid(Pool2, z2, 1), "") For z3 = 1 To Len(Pool3) If ohneWdh Then Pool4 = Replace(Pool3, Mid(Pool3, z3, 1), "") For z4 = 1 To Len(Pool4) Erg = Erg & Mid(Pool1, z1, 1) & Mid(Pool2, z2, 1) _ & Mid(Pool3, z3, 1) & Mid(Pool4, z4, 1) & "|" Next Next Next Next Arr = Split(Erg, "|") Arr = WorksheetFunction.Transpose(Arr) Cells(1, 1).Resize(UBound(Arr) - LBound(Arr) + 1, 1) = Arr End Sub

Option Explicit Public Ergebnis As String Sub start() Dim arr Ergebnis = "" Call Schleife("123456789", 4, True) arr = Split(Ergebnis, "|") arr = WorksheetFunction.Transpose(arr) Cells(1, 1).Resize(UBound(arr, 1) - LBound(arr, 1) + 1, 1).Value = arr End Sub Private Sub Schleife(ByVal Pool As String, Anzahl As Long, ohneWdh As Boolean, Optional pos As _ Long = 1, Optional TeilErg As String = "") Dim i As Long Dim Poolx As String For i = 1 To Len(Pool) If pos = Anzahl Then Ergebnis = Ergebnis & TeilErg & Mid(Pool, i, 1) & "|" Else Poolx = Pool If ohneWdh Then Poolx = Replace(Poolx, Mid(Pool, i, 1), "") Call Schleife(Poolx, Anzahl, ohneWdh, pos + 1, TeilErg & Mid(Pool, i, 1)) End If Next End Sub

Beliebteste Forumthreads (12 Monate)

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread