Hallo Oliver,
das war eine echte Herausforderung.
In der Kombinatorik sind Kombinationen mit Wiederholung und mit Berücksichtigung der Anordnung einfach zu liefern (s. meinen ersten Beitrag), davon gibt es jeweils n^k Stück.
Was du willst sind aber Kombinationen mit Wiederholung und ohne Berücksichtigung der Anordnung. Davon gibt es (n+k-1 über k) Stück.
Mein Ergebnis sieht so aus:
Sub Haupt()
Dim fehl As Boolean
Dim Feld() As Long
Dim GrundElem As Long
Dim Ordnung As Long
Dim spalte As Long
Dim Werte() As Long
Dim wsEin As Worksheet
Dim wsAus As Worksheet
Dim zeile As Long
Dim zf As String
' Zu kombinierende Werte aus Tabelle 1 einlesen
' (Die Werte stehen in Spalte A, lückenlos ab A1)
Set wsEin = ThisWorkbook.Worksheets(1)
GrundElem = wsEin.Cells(wsEin.Rows.Count, 1).End(xlUp).Row
ReDim Werte(1 To GrundElem)
For zeile = 1 To GrundElem
Werte(zeile) = wsEin.Cells(zeile, 1)
Next zeile
' Ordnung der zu erstellenden Kombinationen eingeben
zf = InputBox("Bitte die Ordnung eingeben (1 <= Zahl <= " & GrundElem & ")")
If zf = "" Then Exit Sub
Ordnung = CLng(zf)
If Not (1 <= Ordnung And Ordnung <= GrundElem) Then
MsgBox "Fehlerhafte Eingabe" & vbNewLine & _
"Ordnung = " & Ordnung & " Grundelem = " & GrundElem
Exit Sub
End If
' Ausgabeblatt (Tabelle 2) vorbereiten
Set wsAus = ThisWorkbook.Worksheets(2)
wsAus.UsedRange.ClearContents
wsAus.Cells(1, 1) = "Kombinationen " & Ordnung & "-ter Ordnung von " & _
GrundElem & " Elementen, mit Wiederholung, " & _
"ohne Berücksichtigung der Anordnung"
' Kombinationen berechnen
Komb_mitWied_ohneBerück_Anord GrundElem, Ordnung, Feld(), fehl
If fehl Then
MsgBox "Bei der Berechnung ist ein Fehler aufgetreten"
Exit Sub
End If
' Kombinationen in das Ausgabeblatt schreiben
If UBound(Feld, 1) + 1 > wsAus.Rows.Count Then
MsgBox "Zuviele Zeilen: " & UBound(Feld, 1) + 1
Exit Sub
End If
If UBound(Feld, 2) > wsAus.Columns.Count Then
MsgBox "Zuviele Spalten: " & UBound(Feld, 2)
Exit Sub
End If
For zeile = 2 To UBound(Feld, 1) + 1
For spalte = 1 To UBound(Feld, 2)
wsAus.Cells(zeile, spalte) = Werte(Feld(zeile - 1, spalte))
Next spalte
Next zeile
End Sub
Sub Komb_mitWied_ohneBerück_Anord(N As Long, K As Long, Feld() As Long, Fehler As Boolean)
' Kombinationen K-ter Ordnung von N Elementen
' mit Wiederholung ohne Berücksichtigung der Anordnung
' Anzahl der Kombinationen: (N + K - 1 über K )
' Ergebnis: Die i-te Kombination steht in Feld(i, j) [j = 1, ..., K]
' [i = 1, ..., (N + K - 1 über K )]
Dim i As Long
Dim j As Long
Dim l As Long
Dim og1 As Long
Dim og2 As Long
Teilmengen N + K - 1, K, Feld(), Fehler
If Fehler Then Exit Sub
og1 = UBound(Feld, 1)
og2 = UBound(Feld, 2)
For i = 1 To og1
For j = 1 To og2
For l = 1 To K - 1
If Feld(i, j) = N + l Then Feld(i, j) = Feld(i, l)
Next l
Next j
Next i
End Sub
Sub Teilmengen(N As Long, K As Long, Feld() As Long, Fehler As Boolean)
' K-elementige Teilmengen einer N-elementigen Menge
' (Kombinationen K-ter Ordnung von N Elementen
' ohne Wiederholung ohne Berücksichtigung der Anordnung)
' Anzahl der Teilmengen: (N über K )
' Ergebnis: Die i-te Teilmenge steht in Feld(i, j) [j = 1, ..., K]
' [i = 1, ..., (N über K )]
Dim Hilfs1() As Long
Dim Hilfs2() As Long
Dim i As Long
Dim j As Long
Dim og1 As Long
Dim og2 As Long
If K > N Then
MsgBox "Fehlerhafter Aufruf" & vbNewLine & _
"N = " & N & " K = " & K
Fehler = True
Exit Sub
End If
If K = 1 Then
ReDim Feld(1 To N, 1 To 1)
For i = 1 To N
Feld(i, 1) = i
Next i
Exit Sub
End If
If K = N Then
ReDim Feld(1 To 1, 1 To K)
For i = 1 To K
Feld(1, i) = i
Next i
Exit Sub
End If
If N - 1 = 1 And K = 1 Then
ReDim Hilfs1(1 To 1, 1 To 1)
Hilfs1(1, 1) = 1
Else
Teilmengen N - 1, K, Hilfs1(), Fehler
If Fehler Then Exit Sub
End If
If N - 1 = 1 And K - 1 = 1 Then
ReDim Hilfs2(1 To 1, 1 To 1)
Hilfs2(1, 1) = 1
Else
Teilmengen N - 1, K - 1, Hilfs2(), Fehler
If Fehler Then Exit Sub
End If
og1 = UBound(Hilfs1, 1)
og2 = UBound(Hilfs2, 1)
ReDim Feld(1 To og1 + og2, 1 To K)
For i = 1 To og1
For j = 1 To K
Feld(i, j) = Hilfs1(i, j)
Next j
Next i
For i = og1 + 1 To og1 + og2
For j = 1 To K - 1
Feld(i, j) = Hilfs2(i - og1, j)
Next j
Feld(i, K) = N
Next i
End Sub
Du kopierst das Ganze in einen Modul und startest das Haupt-Programm.
Erläuterung stehen im Programm.
MfG
Dieter