Const Ch$ = "80;70;60;50;40;30;20;10;0", Nb% = 4
Function CombinPond() As Variant
Dim a$(), b%, i&, d&(), h#(), e#, f#, c#, j%
Application.Volatile
a = Split(Ch, ";"): b = UBound(a) + 1
If Nb > b Then CombinPond = "Constantes Ch & Nb incompatibles": Exit Function
For i = 1 To b
If Not IsNumeric(a(i - 1)) Then CombinPond = "Ch contient élément(s) non numériques": Exit Function
Next i
d = CbTab(b, Nb): f = UBound(d): ReDim h(f)
For i = 1 To f
c = 1
For j = 1 To Nb: c = c * a(d(i, j) - 1): Next j
h(i) = h(i - 1) + c
Next i
Randomize: c = h(f) * Rnd
For i = 1 To f
If c < h(i) Then
CombinPond = d(i, 1)
For j = 2 To Nb: CombinPond = CombinPond & ";" & d(i, j): Next j
Exit Function
End If
Next i
CombinPond = "Echec, revoir chaine Ch"
End Function
'Tableau des combinaisons de b objets parmi a objets
Private Function CbTab(ByVal a&, ByVal b&) As Long()
Dim n, t&(), c&, i&, j&, d As Boolean
If a < 1 Or b < 1 Or b > a Then ReDim t(0): GoTo LineEnd
n = CombinNb(a, b)
If IsError(n) Then ReDim t(0): GoTo LineEnd
On Error Resume Next
ReDim t(1 To n, 1 To b)
If TabDim(t) = 0 Then ReDim t(0): GoTo LineEnd
On Error GoTo 0
c = a - b
For i = 1 To b: t(1, i) = i: Next i
For i = 2 To n
If b = 1 Then t(i, 1) = t(i - 1, 1) + 1 Else t(i, 1) = t(i - 1, 1) - (t(i - 1, 2) = c + 2)
For j = 2 To b - 1
If Not (t(i - 1, j + 1) = c + j + 1) Then t(i, j) = t(i - 1, j) Else d = t(i - 1, j) = c + j: t(i, j) = t(i + Not d, j + d) + 1
Next j
If t(i - 1, b) = a Then t(i, b) = t(i, b - 1) + 1 Else t(i, b) = t(i - 1, b) + 1
Next i
LineEnd:
CbTab = t
End Function
'Nb de combinaisons, b objets parmi a objets
Private Function CombinNb(ByVal a&, ByVal b&) As Variant
Dim c&
If a < 0 Or b < 0 Or b > a Then
CombinNb = CVErr(xlErrNA)
Else
c = a - b
If b < c Then c = b
If c = 0 Then CombinNb = 1 Else CombinNb = MathFactoriel(a, c) / MathFactoriel(c)
End If
End Function
'MathFactoriel, option préciser nb de termes
Private Function MathFactoriel(ByVal Nb&, Optional Iter& = 0) As Variant
Dim i&, n&
If Nb < 0 Or Iter < 0 Or Iter > Nb Then MathFactoriel = CVErr(xlErrNA): Exit Function
If Iter = 0 Then Iter = Nb
MathFactoriel = 1
For i = 0 To Iter - 1
MathFactoriel = MathFactoriel * (Nb - i)
If MathFactoriel > 99999999999999# Then MathFactoriel = CVErr(xlErrNum): Exit Function
Next i
End Function
'Nb dimensions d'un tableau (0 si non initialisé)
Private Function TabDim(Tb) As Byte
Dim d&, p
On Error GoTo Fin
Do: d = d + 1: p = UBound(Tb, d): Loop
Fin:
TabDim = d - 1
End Function
