Dim h&, d As Object, d1 As Object 'variables mémorisées pour accélérer la fonction
Function ValeursNonClassees(P As Range)
Dim c As Range, i&, j%
If Not IsArray(d) Then 'au tout début
h = P.Rows.Count
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In P
d(c.Value) = d(c.Value) + 1
Next
End If
d1.RemoveAll 'RAZ
For i = 1 To h
For j = 1 To 5
If Application.CountIf(P.Columns(j), P(i, j)) < d(P(i, j).Value) _
Then d1(P(i, j).Value) = "" 'valeurs sans doublon
Next j, i
ValeursNonClassees = d1.Count
End Function
Sub Minimum()
Dim NbTirage&, mini&, P As Range, t, test() As Boolean
Dim dc&, tirage&, c As Range, j%, n&, i&, k%, memo
NbTirage = [N6] 'nombre de tirages
mini = 1000000
Application.ScreenUpdating = False
With [A1].CurrentRegion.Resize(, 5)
.Copy [G1]
h = .Rows.Count
End With
Set P = [G1].Resize(h, 5)
t = P 'tableau VBA
ReDim test(1 To h, 1 To 5) 'tableau VBA
Set d = CreateObject("Scripting.Dictionary")
Set d1 = CreateObject("Scripting.Dictionary")
'---liste des valeurs sans doublon et comptage---
For Each c In P
d(c.Value) = d(c.Value) + 1
Next
dc = d.Count
Range("Q2:S" & Rows.Count) = "" 'RAZ
[Q2].Resize(dc) = Application.Transpose(d.keys)
[R2].Resize(dc) = Application.Transpose(d.items)
[S2].Resize(dc) = "=RAND()" 'ALEA()
'---détermination du minimum---
For tirage = 1 To NbTirage
[Q2].Resize(dc, 3).Sort [S2], Header:=xlNo 'tri aléatoire
For Each c In [Q2].Resize(dc)
'---comptage préalable---
For j = 1 To 5
n = 0
For i = 1 To h
If Not test(i, j) Then
For k = 1 To 5
If t(i, k) = c Then
n = n + 1
If n = c(1, 2) Then GoTo 1
Exit For
End If
Next k
End If
Next i, j
'---permutations dans t, repérages dans test---
1 If n = c(1, 2) Then
For i = 1 To h
If Not t(i, j) Then
For k = 1 To 5
If t(i, k) = c Then
t(i, k) = t(i, j)
t(i, j) = c
test(i, j) = True
Exit For
End If
Next k
End If
Next i
End If
Next c
ReDim test(1 To h, 1 To 5) 'RAZ du repérage
P = t
If Round([M3]) < mini Then mini = Round([M3]): memo = P 'mémorisation
Next tirage
P = memo 'restitution
'---coloration des valeurs non classées---
For i = 1 To h
For j = 1 To 5
If Application.CountIf(P.Columns(j), P(i, j)) < d(P(i, j).Value) Then
P(i, j).Font.ColorIndex = 3 'rouge
P(i, j).Font.Bold = True 'gras
End If
Next j, i
Set d = Nothing 'RAZ
End Sub