1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
| Private Sub Worksheet_Change(ByVal Target As Range) ' Marco57 de VeriTi.net, et R.Morineau, Mars2010
'la ligne suivante declare les dest de 1 a 14 en type variant et seulement Dest15 en range
'Dim Dest1, Dest2, Dest3, Dest4, Dest5, Dest6, Dest7, Dest8, Dest9, Dest10, Dest11, Dest12, Dest13, Dest14, Dest15 As Range
'il faut repeter as ... en vb
'Dim Dest1 As Range, Dest2 As Range, Dest3 As Range, Dest4 As Range, Dest5 As Range, Dest6 As Range, Dest7 As Range, Dest8 As Range, Dest9 As Range, Dest10 As Range, Dest11 As Range, Dest12 As Range, Dest13 As Range, Dest14 As Range, Dest15 As Range
'Mais comme expliqué dans mon autre message il faut faire des tableaux, ici un tableau de range
Dim DestRange(14) As Range 'a mettre a la place de la declaration des 15 Dest
Dim xDest As Integer
Dim Col As New Collection, Cible%, NbM%, cNbM%, Diff%, NbR
Dim x%, i%, x0%, x1%, x2%, x3%, x4%, x5%, x6%, x7%, x8%, x9%, x10%, x11%, x12%, x13%, x14%, N%, R%
ReDim Table2(2, 0), Table3(2, 0), Table4(2, 0), Table5(2, 0), Table6(2, 0), Table7(2, 0), Table8(2, 0), Table9(2, 0), Table10(2, 0), Table11(2, 0), Table12(2, 0), Table13(2, 0), Table14(2, 0), Table15(2, 0)
'Idem 1ere remarque
Dim x0min, x1min, x2min, x3min, x4min, x5min, x6min, x7min, x8min, x9min, x10min, x11min, x12min, x13min, x14min As Integer
If Not Intersect(Target, Union([Data], [NbMembres], [SomCible])) Is Nothing Then
If Intersect(Target, Union([Data], [NbMembres], [SomCible])).Cells.Count = 1 Then
Cible = [SomCible].Value
NbM = [NbMembres].Value
For x = 1 To [Data].Cells.Count
Col.Add [Data].Cells(x), CStr(x)
If [Data].Cells(x) > 0 Then
N = x - 1 'Nbre maxi correspondant à la dernière donnée non-nulle
R = R + 1 'Nbre réel de données non nulles (sans celles nulles avant N)
End If
Next x
If Not 2 <= Col.Count <= 9 Then
MsgBox "Le Nombre de Probabilité(s) Différente(s) de Zéro n'est pas correct": Exit Sub
End If
If 1 > NbM Or NbM > 15 Then
MsgBox "Le Nombre de Membres doit être un Entier entre 1 et 15 (inclus)": Exit Sub
End If
While Fact(R + i) / (Fact(i) * Fact(R)) < 65000 And i <= NbM 'Protection anti-saturation
cNbM = i 'Nbre de membres max/uplet corrigé
i = i + 1
Wend
For xDest = 1 To 14
Set DestRange(xDest) = Range("Dest" & xDest & "Uplets").Cells
Next
'remplace tous les set
'Set Dest2 = [Dest2Uplets].Cells
'Set Dest3 = [Dest3Uplets].Cells
'Set Dest4 = [Dest4Uplets].Cells
'Set Dest5 = [Dest5Uplets].Cells
'Set Dest6 = [Dest6Uplets].Cells
'Set Dest7 = [Dest7Uplets].Cells
'Set Dest8 = [Dest8Uplets].Cells
'Set Dest9 = [Dest9Uplets].Cells
'Set Dest10 = [Dest10Uplets].Cells
'Set Dest11 = [Dest11Uplets].Cells
'Set Dest12 = [Dest12Uplets].Cells
'Set Dest13 = [Dest13Uplets].Cells
'Set Dest14 = [Dest14Uplets].Cells
'Set Dest15 = [Dest15Uplets].Cells
[Results].Cells.ClearContents |
Partager