CASSE TETE :Colorer texte dans cellulle selon 3 conditions aleatoires

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

MARINAM

XLDnaute Nouveau
Bonjour,

j'ai un souci dont je n'arrive pas à trouver la solution,
j'ai un fichier qui contient des subtype en J (différents sur chaque ligne) et des missions réalisées (concaténées) de K à N
j'aimerais colorer les "subtypes" selon Trois conditions:
1) si le subtype est contenu dans la mission 2015: en vert
2) si le subtype est contenu dans la mission 2014: en orange
3) si le subtype n'est pas contenu dans aucune mission: en rouge

La difficulté est qu'une cellule J peut contenir plusieurs subtypes, et qu'à l'idéal ceux ci n'auront pas la même couleur,

j'ai joint un fichier car j'ai peur que mon explication de soit pas très claire.

On oublie les MFC, mon cas est trop bizarre mais comme tout est possible en vba, j'imagine qu'il doit y avoir une solution,
Merci de votre aide 🙂
 

Pièces jointes

Re : CASSE TETE :Colorer texte dans cellulle selon 3 conditions aleatoires

Hello

déjà. voici un début de code qui permet de balayer le tableau. et determiner la couleur qu'il faut appliquer..
reste plus qu'à trouver la ligne de code manquante pour appliquer la couleur
Code:
Sub coloreSubtype()
fin = 5 'dernière ligne du tableau

For ligne = 2 To fin
    
    SubType = Range("J" & ligne)
    'séparation des différents subtype: séparés d'un *
    ST = Split(SubType, "*", -1)
    
    'nombre d'éléments
    'MsgBox UBound(ST)

    'pour chaque soustype, on les recherche dans les zones 2014 et 2015
    For i = 0 To UBound(ST)
        'recherche en 2014 2015
        Set c = Range("K" & ligne & ":N" & ligne).Find(ST(i), LookIn:=xlValues)
        If Not c Is Nothing Then
            'MsgBox c.Address
            If c.Column = 11 Or c.Column = 12 Then
                MsgBox ST(i) & " en Orange"
                'coloration en orange dans la cellule J
            Else:
                MsgBox ST(i) & " en Vert"
                'coloration en Vert dans la cellule J
            End If
        Else:
            MsgBox ST(i) & " en Rouge"
            'coloration en rouge dans la cellule J
        End If
    Next i
Next ligne

End Sub
 
Re : CASSE TETE :Colorer texte dans cellulle selon 3 conditions aleatoires

et voila ;-)

Code:
Sub coloreSubtype()
fin = Range("J65536").End(xlUp).Row 'dernière ligne du tableau

For ligne = 2 To fin
    
    SubType = Range("J" & ligne)
    'séparation des différents subtype: séparés d'un *
    ST = Split(SubType, "*", -1)
    
    'nombre d'éléments
    'MsgBox UBound(ST)

    'pour chaque soustype, on les recherche dans les zones 2014 et 2015
    For i = 0 To UBound(ST)
        debut = InStr(1, SubType, ST(i))
        longueur = Len(ST(i))
        'recherche en 2014 2015
        Set c = Range("K" & ligne & ":N" & ligne).Find(ST(i), LookIn:=xlValues)
        If Not c Is Nothing Then
            'MsgBox c.Address
            If c.Column = 11 Or c.Column = 12 Then
                'MsgBox ST(i) & " en Orange"
                'coloration en orange dans la cellule J
                With Cells(ligne, 10).Characters(Start:=debut, Length:=longueur).Font
                    .Color = -16727809
                End With
            Else:
                'MsgBox ST(i) & " en Vert"
                'coloration en Vert dans la cellule J
                With Cells(ligne, 10).Characters(Start:=debut, Length:=longueur).Font
                    .Color = -11480942
                End With
            End If
        Else:
            'MsgBox ST(i) & " en Rouge"
            'coloration en rouge dans la cellule J
            With Cells(ligne, 10).Characters(Start:=debut, Length:=longueur).Font
                    .Color = -16776961
            End With
        End If
    Next i
Next ligne

End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour