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 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131
|
Sub pourcentage_dernière_perf()
Dim Discipline As String
Dim Nombre_de_chevaux As Integer
Dim NomCheval As String
Dim Resultat As Variant
Dim DernPerf As Variant
Dim compteur As Integer
Dim pourcentage As Single
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer
Dim tableau(3, 6) As Integer
''''''''''''''Compteur pour barre de progression
'compteur = 1
''''''''''''''Remise à zéro du tableau dernière performance
For i = 1 To 3
For j = 1 To 6
tableau(i, j) = 0
Range("a1").Offset(i, j) = 0
Next j
Next i
Nombre_de_chevaux = Workbooks("BDD globale").Sheets("chevaux").Range("a10000").End(xlUp).Row
For i = 0 To 100 '(Nombre_de_chevaux - 1)
''''''''''Déterminer NomCheval pour "ouvrir" la feuille cheval
NomCheval = Workbooks("BDD globale").Sheets("chevaux bis").Range("a1").Offset(i, 0)
''''''''''Déterminer la discipline
If Workbooks("BDD globale").Sheets(NomCheval).Range("f2") = "Plat" Then
Discipline = "Plat"
Else
Discipline = "Autre"
End If
''''''''''Déterminer le nombre de performance du cheval
NbPerf = Workbooks("BDD globale").Sheets(NomCheval).Range("a300").End(xlUp).Row - 1
''''''''''Si conditions remplies, faire comparatif entre DernPerf et Resultat
If (NbPerf > 2) And (Discipline = "Plat") Then
For j = 2 To NbPerf
DernPerf = Workbooks("BDD globale").Sheets(NomCheval).Range("k1").Offset(j, 0)
Resultat = Workbooks("BDD globale").Sheets(NomCheval).Range("k1").Offset((j - 1), 0)
Select Case DernPerf
Case 1
tableau(1, 1) = tableau(1, 1) + 1
Select Case Resultat
Case 1
tableau(2, 1) = tableau(2, 1) + 1
Case 2 To 3
tableau(3, 1) = tableau(3, 1) + 1
Case Else
End Select
Case 2
tableau(1, 2) = tableau(1, 2) + 1
Select Case Resultat
Case 1
tableau(2, 2) = tableau(2, 2) + 1
Case 2 To 3
tableau(3, 2) = tableau(3, 2) + 1
Case Else
End Select
Case 3
tableau(1, 3) = tableau(1, 3) + 1
Select Case Resultat
Case 1
tableau(2, 3) = tableau(2, 3) + 1
Case 2 To 3
tableau(3, 3) = tableau(3, 3) + 1
Case Else
End Select
Case 4
tableau(1, 4) = tableau(1, 3) + 1
Select Case Resultat
Case 1
tableau(2, 4) = tableau(2, 4) + 1
Case 2 To 3
tableau(3, 4) = tableau(3, 4) + 1
Case Else
End Select
Case 5
tableau(1, 5) = tableau(1, 5) + 1
Select Case Resultat
Case 1
tableau(2, 5) = tableau(2, 5) + 1
Case 2 To 3
tableau(3, 5) = tableau(3, 5) + 1
Case Else
End Select
Case Else
tableau(1, 6) = tableau(1, 6) + 1
Select Case Resultat
Case 1
tableau(2, 6) = tableau(2, 6) + 1
Case 2 To 3
tableau(3, 6) = tableau(3, 6) + 1
Case Else
End Select
End Select
Next j
End If
Next i
'''''''''Affichage des résultats
For k = 1 To 3
For l = 1 To 6
Range("a1").Offset(k, l) = tableau(k, l)
Next l
Next k
End Sub |
Partager