Kombinationen mit Zurücklegen
09.08.2014 10:27:14
cross
Hi Erhard,
da habe ich wohl etwas für dich gefunden:
Sub TestIt()
Dim nn As Integer, kk As Integer, arE, arN, arK, ee As Long, ss As Long
arK = Array(1, 3, 7, 9)
arE = KombisMitZurueck(4, 6)
ReDim arN(1 To UBound(arE), 1 To 6)
For nn = 1 To UBound(arE)
ss = 0
For kk = 1 To 6
ss = ss + arK(arE(nn, kk) - 1)
Next kk
If ss = 10 Or ss = 20 Or ss = 30 Then
ee = ee + 1
For kk = 1 To 6
arN(ee, kk) = arK(arE(nn, kk) - 1)
Next kk
End If
Next nn
Cells(2, 1).Resize(ee, 6) = arN
End Sub
Function KombisMitZurueck(ByVal nn As Long, ByVal kk As Integer)
Dim ar As Variant, ii As Long, jj As Integer, lngSize As Long
lngSize = WorksheetFunction.Combin(nn - 1 + kk, kk)
ReDim ar(1 To lngSize, 1 To kk)
For jj = 1 To kk
ar(1, jj) = 1
Next jj
For ii = 2 To lngSize
For jj = 1 To kk
ar(ii, jj) = ar(ii - 1, jj)
Next jj
arInc ar, ii, nn, kk, kk
Next ii
KombisMitZurueck = ar
End Function
Sub arInc(ar, ByVal ii As Long, ByVal nn As Integer, ByVal kk As Integer, _
ByVal lngSp As Integer)
Dim intVal As Integer, jj As Integer
If ar(ii, lngSp)
Eine Quelle:
https://www.herber.de/forum/archiv/1000to1004/1001022_Kombinationen_mit_Zuruecklegen_ohne_Reihenfolge.html
Rückmeldung wäre nett! - Grüße aus Kamp-Lintfort von Erich und: Schönes Wochenende allerseits!