Re : Compter le nombre de cellules en couleur selon leur valeur
Re bonjour
Je t'envoie les 2 codes:
MERCI
' Dans Module1
Option Explicit
Sub Compte_Couleurs()
Dim Indice As Integer
Dim Trouve As Boolean
Dim Cel As Range
Dim J As Long
Dim K As Long
Dim Tablo()
Dim Zone_Cherche As Range
Dim Cherche As String
' Range("AD1:AE" & Range("AE65536").End(xlUp).Row).ClearContents
' Zone d'écriture (que j'efface)
Range("F352:G" & Range("G65536").End(xlUp).Row).ClearContents
' Set Zone_Cherche = Range("E2:AA2")
' Zone de recherche du score
Set Zone_Cherche = Range("AL5:BH5")
ReDim Preserve Tablo(1, Indice)
' For K = 4 To Range("B65536").End(xlUp).Row
' 4 = Ligne de départ dans la colonne B
' Pour toi
' 8 = Ligne de départ dans la colonne AJ
For K = 8 To Range("AJ65536").End(xlUp).Row
' Cherche = CStr(Cells(K, 2).Value) & " - " & CStr(Cells(K, 3).Value)
' Colonne B = 2 et suivante = 3
' Pour toi
' Colonne AJ = 36 et suivante = 37
Cherche = CStr(Cells(K, 36).Value) & " - " & CStr(Cells(K, 37).Value)
Set Cel = Zone_Cherche.Find(Cherche, LookIn:=xlValues, lookat:=xlWhole)
If Cel Is Nothing Then
'
' Si je n'ai pas trouvé le score je vais me positionner sur la colonne 'Autres'
Set Cel = Zone_Cherche.Find("Autres", LookIn:=xlValues, lookat:=xlWhole)
End If
' If Not Cel Is Nothing Then
' Cel.Select
Trouve = False
For J = 0 To UBound(Tablo, 2)
If Tablo(1, J) = Cells(K, Cel.Column).Value Then
Tablo(0, J) = Tablo(0, J) + 1
Trouve = True
Exit For
End If
Next J
If Trouve = False Then
Tablo(1, Indice) = Cells(K, Cel.Column).Value
Tablo(0, Indice) = 1
Indice = Indice + 1
ReDim Preserve Tablo(1, Indice)
End If
' End If
Next K
' Tri
Do
Trouve = False
For J = 0 To UBound(Tablo, 2) - 2
If Tablo(1, J) > Tablo(1, J + 1) Then
Trouve = True
K = Tablo(1, J + 1)
Tablo(1, J + 1) = Tablo(1, J)
Tablo(1, J) = K
K = Tablo(0, J + 1)
Tablo(0, J + 1) = Tablo(0, J)
Tablo(0, J) = K
End If
Next J
Loop Until Trouve = False
' Affichage
For J = 0 To UBound(Tablo, 2) - 1
' Cells(1 + J, 30).NumberFormat = "0.00"
' Cells(1 + J, 30) = Tablo(1, J)
' Cells(1 + J, 31) = Tablo(0, J) & " fois"
' J'écrivais ligne 1 + J, Colonne 30 et 31 (AD et AE)
' Tu veux Ligne 352 + J et Colonne 6 et 7 (F et G)
Cells(352 + J, 6).NumberFormat = "0.00"
Cells(352 + J, 6) = Tablo(1, J)
Cells(352 + J, 7) = Tablo(0, J) & " fois"
Next J
' A suuprimer
' Columns("AD:AE").AutoFit
End Sub
Option Explicit
Code de la feuille nommée "Grilles"
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' If Not Intersect(Range("B4:AA7"), Target) Is Nothing Then
' B4:AA7 : Coordonnées de la plage à 'surveiller'
' Dans ton exemple cela va être AJ8:BH349
If Not Intersect(Range("AJ8:BH349"), Target) Is Nothing Then
Application.EnableEvents = False
Compte_Couleurs
Application.EnableEvents = True
End If
End Sub