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
| Sub MettreEnEvidenceLePlusJeuneParCategorie(ByVal FeuilleEncours As Worksheet, ByVal TitreLigne As Long, ByVal Sexe As String)
If ChargementMatriceCategories(Sexe) = True Then
With FeuilleEncours
.Cells.Interior.Color = xlNone ' Pour effacer les couleurs existantes
ColonneCategorie = 6
DerniereLigneEpreuve = .Cells(.Rows.Count, 1).End(xlUp).Row
If DerniereLigneEpreuve > TitreLigne Then
Set AireCategories = .Range(.Cells(TitreLigne + 1, ColonneCategorie), .Cells(DerniereLigneEpreuve, ColonneCategorie))
For I = LBound(MatriceCategories, 2) To UBound(MatriceCategories, 2)
For Each CelluleCategories In AireCategories
If CelluleCategories = MatriceCategories(0, I) Then
With .Range(.Cells(CelluleCategories.Row, 1), .Cells(CelluleCategories.Row, 9))
.Interior.Color = MatriceCategories(1, I)
.Font.Color = MatriceCategories(2, I)
Exit For
' Exit Sub ' Pour ne mettre en évidence que le premier de la plus jeune des catégories.
End With
End If
Next CelluleCategories
Next I
Set AireCategories = Nothing
End If
End With
End If
End Sub |
Partager