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 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97
|
Sub AnalyseNumeros()
Dim ws As Worksheet
Dim rng As Range
Dim dict As Object
Dim cell As Range
Dim topNumbers() As String
Dim bottomNumbers() As String
Dim i As Integer
' Spécifiez la feuille de calcul à utiliser
set ws= ThisWorkbook.Worksheets("Etude statistique")
' Spécifiez la plage de données (colonnes M, N, et O)
Set rng = ws.Range("M2:O" & ws.Cells(ws.Rows.Count, "M").End(xlUp).Row)
' Créez un dictionnaire pour stocker les numéros et leurs occurrences
Set dict = CreateObject("Scripting.Dictionary")
' Parcourez les données et remplissez le dictionnaire
For Each cell In rng.Rows
dict(cell.Cells(1, 1).Value) = cell.Cells(1, 2).Value
Next cell
' Triez le dictionnaire par ordre décroissant d'occurrences
Dim sortedDict As Object
Set sortedDict = SortDictionaryByValue(dict, False)
' Initialisez les tableaux pour les numéros les plus tirés et les moins tirés
ReDim topNumbers(1 To 10)
ReDim bottomNumbers(1 To 10)
' Remplissez les tableaux avec les numéros correspondants
i = 1
Dim Key As Variant ' Déclaration de la variable Key
For Each Key In sortedDict.keys
If i <= 10 Then
topNumbers(i) = Key
End If
If i > sortedDict.Count - 10 Then
bottomNumbers(i - (sortedDict.Count - 10)) = Key
End If
i = i + 1
Next Key
' Affichez les résultats dans la feuille de calcul
ws.Cells(2, 2).Value = Join(bottomNumbers, ", ")
ws.Cells(3, 2).Value = Join(topNumbers, ", ")
' Mettez en forme les cellules en vert pour les numéros les moins tirés
For Each cell In ws.Range("B2").Resize(10)
cell.Font.Color = RGB(0, 176, 80) ' Vert
Next cell
' Mettez en forme les cellules en rouge pour les numéros les plus tirés
For Each cell In ws.Range("B3").Resize(10)
cell.Font.Color = RGB(255, 0, 0) ' Rouge
Next cell
End Sub
Function SortDictionaryByValue(dict As Object, Optional descending As Boolean = False) As Object
Dim keys() As Variant
Dim k As Variant
Dim values() As Variant
Dim i As Long, j As Long
Dim tempKey As Variant, tempValue As Variant
' Mettez les clés et les valeurs dans des tableaux
i = 0
For Each k In dict.keys
i = i + 1
ReDim Preserve keys(1 To i)
ReDim Preserve values(1 To i)
keys(i) = k
values(i) = dict(k)
Next k
' Triez les tableaux en fonction des valeurs
For i = 1 To UBound(values)
For j = i + 1 To UBound(values)
If (values(i) < values(j) And Not descending) Or (values(i) > values(j) And descending) Then
tempValue = values(i)
values(i) = values(j)
values(j) = tempValue
tempKey = keys(i)
keys(i) = keys(j)
keys(j) = tempKey
End If
Next j
Next i
' Créez un nouveau dictionnaire trié
Set SortDictionaryByValue = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(keys)
SortDictionaryByValue(keys(i)) = values(i)
Next i
End Function |
Partager