Trouvez valeur maximale mais de cellules colorées

Je ne suis pas familier avec la création de code VBA, y a-t-il quelqu'un qui pourrait m'aider pour trouver :

une fonction qui revoit la valeur maximale d'une plage en tenant compte uniquement des cellules colorées de cette plage.

Merci

Bonjour,

plusieurs pistes, dépendant du contexte de ton fichier et d'à quel point tu veux utiliser/éviter VBA.

Les cellules colorées sont-elles toutes colorées de la même couleur ?

Pourquoi sont-elles colorées ?

Si c'est parce qu'elles dépendent d'un critère, c'est peut-être réalisable relativement simplement avec une formule.

Avec un peu plus de précisions sur le contexte et un petit exemple sur un fichier, ça ne devrait pas poser de souci

Afin d'éviter de partir sur une mauvaise piste, pourrais tu nous joindre un fichier (la façon dont tu obtiens la coloration de ta cellule est importante)

Bonjour,

J'aimerais une fonction, via vba, qui trouve dans une plage de date (certaines cellules étant vides et sans couleur, d'autres avec une date sans couleur et d'autres cellule avec une date et couleur entrée manuellement) la valeur de la date la plus élevé uniquement parmi les dates de cellules colorée (couleur verte 5296274). Voir fichier ci-joint.

Merci

Je sais que la fonction max_si_couleur du pack fonctionne mais je dois partagé mon fichier et je crois que ça ne fonctionnera pas pour les autres personnes ?

S'il y a lieu, pourrais-je simplement avoir le code pour cette fonction ?

Bonsoir monex, le forum,

Un essai....mais il y a certainement moyen de faire mieux,

Private Sub CommandButton1_Click()
 Dim i As Integer, dl As Integer
  With Sheets("Feuil1")
      dl = 1
   For i = 2 To 12
    'If .Cells(2, i).Value <> "" And .Cells(2, i).Interior.ColorIndex <> xlNone Then
    If .Cells(2, i).Value <> "" And .Cells(2, i).Interior.Color = 5296274 Then
       .Cells(2, i).Copy .Cells(dl, "AAA")
    End If
     dl = dl + 1
   Next i
    If Application.WorksheetFunction.CountA(.Range("AAA:AAA")) = 0 Then .Range("A2") = "": Exit Sub
    On Error Resume Next
    .Range("A2") = Application.Max(.Columns("AAA"))
    .Columns("AAA").Delete
  End With
End Sub

Cordialement