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