Microsoft 365 VBA Function Recherche d'une couleur et renvoi résultats

[Englobe]

Bonjour,
J'ai fait une recherche et je n'ai pas trouvé.

J'ai une fonction qui compte le nombre de cellule d'une couleur dans une plage.
J'ai une fonction qui recherche une donnée dans une plage et renvoi les résultats dans une seule cellule.

J'aimerais une fonction qui recherche une couleur dans une plage et renvoi les résultats dans une seule cellule. Les résultats dans cette cellule doivent être un sous l'autre soit avec renvoi à la ligne.
Je buche depuis plusieurs heures mais sans résultats.



Je joins un fichier de travail.
Merci à l'avance.

 

[Englobe]

Bonjour,

J'essai avec ce jumelage mais sans résultat.

Function RenvoiResultat(PlageCouleur As Range, Couleur As Range)
Dim CodeCouleur As Integer
CodeCouleur = Couleur.Interior.ColorIndex
    Set CCell = PlageCouleur
    For Each CCell In PlageCouleur
    If CCell.Interior.ColorIndex = CodeCouleur Then
     RenvoiResultat = RenvoiResultat & Chr(10) & t(i, 1)   
    End If
    Next CCell
End Function

Je cherche encore.
Merci

 

[riton00]

Bonsoir,

Un éclaircissement stp.....tu cherches le nombre de couleurs différentes Ok et ensuite avec le nombre qui s'y trouve dedans il faut en faire quoi? exemple pour la couleur verte........ il y en à 3 OK et ensuite les chiffres qui sont dans ces couleurs il faut? les additionner, les compter?
Slts

 

[Englobe]

Bonsoir,

Un éclaircissement stp.....tu cherches le nombre de couleurs différentes Ok et ensuite avec le nombre qui s'y trouve dedans il faut en faire quoi? exemple pour la couleur verte........ il y en à 3 OK et ensuite les chiffres qui sont dans ces couleurs il faut? les additionner, les compter?
Slts

Bonsoir,
Je me concentre sur la couleur en A4 soit vert foncé pour l'instant. Je verrai pour trouver par la suite car tenter de par moi-même également.
Je veux que la recherche couleur de A4 me renvoi les nos de références de la colonne B.
Pour les autres couleurs, j'ai seulement besoin du nombres donc c'est ok.

Merci à toi de te pencher sur mon problème.

 

[Englobe]

Bonjour,

Je buche... je cherche l'erreur.
J'essai ce code simple mais toujours comme résultat #VALEUR! en modifiant certains paramètre.

Function RenvoiResultat(Choix As Range, Plage As Range)
    t = Plage
    c = Choix.Interior.ColorIndex
    For i = 13 To UBound(t)
        If t(i, 1).Interior.ColorIndex = c Then RenvoiResultat = RenvoiResultat & Chr(10) & t(i, 2)
    Next i
    RenvoiResultat = Mid(RenvoiResultat, 2)
End Function

Ce que je cherche comme résultat.

Je cherche encore.
Merci

 

[Englobe]

Bonjour, la solution est trouvé avec l'aide de sylvanu.

Sub Remplit()
DL = [A65500].End(xlUp).Row
Set Plage = Range("A13:A" & DL)
For L = 4 To 9
    Cells(L, "B") = RenvoiResultat(Cells(L, "A"), Plage)
    Cells(L, "C") = CompterCouleur(Plage, Cells(L, "A"))
Next L
Rows("4:9").EntireRow.AutoFit
End Sub

Merci à tous.