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 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158
| Sub Ecuries()
With Application
.ScreenUpdating = False
.EnableEvents = True
End With
With Worksheets("Ecurie")
Dim Pvt As PivotTable
Dim i As Integer, j As Integer
Dim car As Variant
i = 5
'Supprime les données déjà dans le tableau
.Range("A5", .Range("G5").End(xlDown)).Select
Selection.ClearContents
.Range("B2:G2").Select
Selection.ClearContents
.Range("A1").Select
Worksheets("Stats").Select
Set Pvt = Worksheets("Stats").PivotTables("Tableau croisé dynamique1")
'Récupère le meilleur temps, la moyenne, le nombre de tours significatifs et l'écart type pour chaque voiture
For Each car In Pvt.PivotFields("Voiture").PivotItems
On Error Resume Next
.Select
.Cells(i, 1).Value = car
.Cells(i, 1).Offset(, 3).Value = Pvt.GetData("'Voiture' " & car & " 'Min'")
.Cells(i, 1).Offset(, 4).Value = Pvt.GetData("'Voiture' " & car & " 'Moyenne'")
.Cells(i, 1).Offset(, 5).Value = Pvt.GetData("'Voiture' " & car & " 'Nombre'")
.Cells(i, 1).Offset(, 6).Value = Pvt.GetData("'Voiture' " & car & " 'Ecart type'")
i = i + 1
Next
'Supprime les lignes des voitures sans données (ne participant pas à l'évènement)
Dim fin As Long
fin = .Cells(.Rows.Count, "A").End(xlUp).Row
On Error Resume Next
.Range("D5:D" & fin).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
i = 1
'Récupère le nom de l'écurie et la catégorie de la voiture en fonction de son numéro
For Each cell In .Range("A5", .Range("A5").End(xlDown))
For Each car In Worksheets("listes").Range("A1", Worksheets("listes").Range("A1").End(xlDown))
If CStr(car) = cell Then
cell.Offset(, 1).Value = Worksheets("listes").Cells(i, 2).Value
cell.Offset(, 2).Value = Worksheets("listes").Cells(i, 3).Value
Exit For
End If
i = i + 1
Next
i = 1
Next
i = 5
'Mise en forme (chiffres significatif, tableau, etc)
.Range(.Cells(i, 4), .Cells(i, 4).End(xlDown)).Select
Selection.NumberFormat = "0.000"
.Range(.Cells(i, 5), .Cells(i, 5).End(xlDown)).Select
Selection.NumberFormat = "0.0"
.Range(.Cells(i, 6), .Cells(i, 6).End(xlDown)).Select
Selection.NumberFormat = "0"
.Range(.Cells(i, 7), .Cells(i, 7).End(xlDown)).Select
Selection.NumberFormat = "0.0"
.Range(.Cells(i, 1), .Cells(i, 7).End(xlDown)).Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
'Calcul du meilleur temps général et de la meilleure moyenne
Set best = .Range("D5", .Range("D5").End(xlDown))
Set moy = .Range("E5", .Range("E5").End(xlDown))
.Range("I1").FormulaArray = "=MIN('Ecurie'!" & best.Address & ")"
.Range("I2").FormulaArray = "=MIN('Ecurie'!" & moy.Address & ")"
'Calcul des moyennes par classe (en commentaire car non fonctionnel pour l'instant)
'Set class = .Range("C5", .Range("C5").End(xlDown))
'Set car = .Range("A5", .Range("A5").End(xlDown))
'.Range("B2").FormulaArray = _
"=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("C5").Value & ")*('Ecurie'!" & car.Address & " < 11),'Ecurie'!" & moy.Address & "))"
'.Range("C2").FormulaArray = _
"=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("C5").Value & ")*('Ecurie'!" & car.Address & "> 10),'Ecurie'!" & moy.Address & "))"
'.Range("D2").FormulaArray = _
"=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("D1").Value & ")*('Ecurie'!" & car.Address & "< 50),'Ecurie'!" & moy.Address & "))"
'.Range("E2").FormulaArray = _
"=AVERAGE(IF(('Ecurie'!" & class.Address & "= GT1),'Ecurie'!" & moy.Address & "))"
'.Range("F2").FormulaArray = _
"=AVERAGE(IF(('Ecurie'!" & class.Address & "= GT2),'Ecurie'!" & moy.Address & "))"
'.Range("G2").FormulaArray = _
"=AVERAGE(IF(('Ecurie'!" & class.Address & "=" & .Range("D1").Value & ")*('Ecurie'!" & car.Address & "> 50),'Ecurie'!" & moy.Address & "))"
'Identification par fond jaune des meilleurs résultats dans le tableau
For Each tps In .Range("D5", .Range("D5").End(xlDown))
If tps.Value = .Range("I1").Value Then
tps.Interior.Color = RGB(250, 250, 0)
Else
tps.Interior.ColorIndex = xlNone
End If
Next
For Each tps In .Range("E5", .Range("E5").End(xlDown))
If tps.Value = .Range("I2").Value Then
tps.Interior.Color = RGB(250, 250, 0)
Else
tps.Interior.ColorIndex = xlNone
End If
Next
'Suppresssion des cellules de calculs temporaires
.Range("I1:I2").Select
Selection.Clear
.Range("A1").Select
End With
End Sub |
Partager