Microsoft 365 Si contient telle liste de mots, colorer en bleu, sinon autre liste en vert, autre en violet..., etc.

Créer une discussion
Répondre

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 !

S'inscrire
anthoYS

anthoYS

XLDnaute Barbatruc
Bonjour


Une liste prédéfinie voir fichier joint.
Et mettre les mots colorés en B en gras. Uniquement ceux-là. Les autres doivent rester sans MEFC, mais en noir sur fond blanc (excel classique).
Si je saisi des mots à la suite en B, n'importe quelle cellule, même en B124 ça doit fonctionner. La liste de mots peut être rallongés donc prendre en compte ceci, de F2:H5... pouvant aller jusqu'à la ligne 20 à peu près...

Ce qui est attendu est justement présent dans l'onglet 'attendu du fichier ci-joint.
Je reste ouvert à toute autre méthode, ou axe d'amélioration.
Car MEFC je pense pouvoir faire, mais là, je préfère par liste qui peut être rallongée (jusqu'à la ligne 20), quitte à nommer ces listes...


Merci par avance !
 

Pièces jointes

Solution
L
Salut @anthoYS ,
Voici la V2 avec quelques modifs
- Les tableaux ont été mis en Tableaux Structurés (TS)
- Le code s'adapte dont à la longueur / largeur des TS
- La couleur est directement récupérée en fonction de la couleur de Police de l’entête
En espérant que cela convienne maintenant
@+ Lolote83
Trier par date Trier par votes
Je pense être en bonne voie là

Formule avec listes nommées, pour la MEFC en B pour les mots bleus voici la MEFC appliquée :
VB: 
=NB.SI(ListeMotsBleus;B2)>0

(voir ci-joint)

Je voudrais faire tout en B, et voilà. J'ai fait un test ça semble OK. Avez-vous une autre idée ?

Puis-je superposer les 2 autres couleurs ?
 

Pièces jointes

Vote positif 0 Vote négatif
J'ai tenté, mais ça ne marche pas. Juste les mots bleus c'est OK.

Une idée ?

EXCEL_evBUghJ10I.png
 

Pièces jointes

Vote positif 0 Vote négatif
@Lolote83 :

VB: 
Sub TestMots()
    For Each xCell In Range("B2:B6")
        xMot = xCell.Value
        xPos = InStr(1, xMot, "/")
        xDecoupe = Split(xMot, "/")
        For F = 0 To UBound(xDecoupe)
            xMot = Trim(xDecoupe(F))
            xCoul = Fct_ChercheCouleurMots(xMot)
            Select Case xCoul
                Case Is = "Mots bleus"
                    xPol = RGB(33, 92, 152)
                    
                Case Is = "Mots verts"
                    xPol = RGB(71, 211, 89)
                    
                Case Is = "Mots violets"
                    xPol = RGB(160, 43, 147)
                    
                Case Else
                    xPol = vbBlack
            End Select
            If xPol <> Empty Then
                If F = 0 Then
                    xDeb = 1
                Else
                    xDeb = xPos + 2
                End If
                xLgrTexte = Len(xMot)
                'Coloriage
                With xCell.Characters(Start:=xDeb, Length:=xLgrTexte).Font
                    .Color = xPol
                    .Bold = True
                End With
            End If
        Next F
    Next xCell
    MsgBox "Terminé"
End Sub

Function Fct_ChercheCouleurMots(xMot)
    For Each xCell In Range("F2:H4")
        If UCase(xMot) = UCase(xCell.Value) Then
            xCoul = Cells(1, xCell.Column)
            Exit For
        Else
            xCoul = Empty
        End If
    Next xCell
    Fct_ChercheCouleurMots = xCoul
End Function

Comment adapter ce code pour des couleurs autres ?
violet, bleu, rouge et vert assez fluo mais pas trop (lisible sur du blanc) ?

à quoi correspond la fonction ? Comment je l'adapte pour un classeur ou c'est totalement différent ?

J'avoue m'y perdre un peu...

Je veux également étendre au-delà de B6 et aller à H21 si j'ajoute des mots... là où c'est blanc, que ça puisse faire la mise à jour après appuie sur le bouton bleu : "COULEUR"


Merci beaucoup le résultat est impeccable !
 
Vote positif 0 Vote négatif
Salut @anthoYS ,
Voici la V2 avec quelques modifs
- Les tableaux ont été mis en Tableaux Structurés (TS)
- Le code s'adapte dont à la longueur / largeur des TS
- La couleur est directement récupérée en fonction de la couleur de Police de l’entête
En espérant que cela convienne maintenant
@+ Lolote83
 

Pièces jointes

Vote positif 0 Vote négatif
Solution
Lolote83 à dit:
Salut @anthoYS ,
Voici la V2 avec quelques modifs
- Les tableaux ont été mis en Tableaux Structurés (TS)
- Le code s'adapte dont à la longueur / largeur des TS
- La couleur est directement récupérée en fonction de la couleur de Police de l’entête
En espérant que cela convienne maintenant
@+ Lolote83
Cliquez pour agrandir...
Bonjour,

C'est bon j'ai pu trouver non sans aide extérieure :=)

Merci


ce code a été retenu :
VB: 
Option Explicit

Sub TestMots()
    Dim ws As Worksheet
    Dim xCell As Range
    Dim xMot As String
    Dim xHeader As String
    Dim xPol As Long
    Dim lastRow As Long
    Dim listeMotsRange As Range
    Dim xDecoupe() As String
    Dim F As Long
    Dim xDeb As Long, xLgrTexte As Long
    Dim curPos As Long
    
    ' Définir la feuille et les zones
    Set ws = ThisWorkbook.Sheets("Feuil1")
    
    ' Trouver la dernière ligne utilisée col B
    lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
    
    ' Plage où chercher les mots colorés (adapter selon données)
    Set listeMotsRange = ws.Range("F2:H20")
    
    ' Boucle sur chaque cellule de la colonne B
    For Each xCell In ws.Range("B2:B" & lastRow)
        If Len(xCell.Value) > 0 Then
            ' Découpe sur "/"
            xDecoupe = Split(xCell.Value, "/")
            
            curPos = 1 'position de recherche pour éviter les doublons
            
            For F = 0 To UBound(xDecoupe)
                xMot = Trim(xDecoupe(F))
                
                ' Cherche la couleur correspondant
                xHeader = Fct_ChercheCouleurMots(xMot, listeMotsRange, ws)
                
                Select Case xHeader
                    Case "Mots bleus": xPol = RGB(33, 92, 152)
                    Case "Mots verts": xPol = RGB(71, 211, 89)
                    Case "Mots violets": xPol = RGB(160, 43, 147)
                    Case Else: xPol = vbBlack
                End Select
                
                If xPol <> vbBlack Then
                    'Position exacte du mot dans la cellule
                    xDeb = InStr(curPos, xCell.Value, xMot)
                    If xDeb > 0 Then
                        xLgrTexte = Len(xMot)
                        ' Mise en forme
                        With xCell.Characters(Start:=xDeb, Length:=xLgrTexte).Font
                            .Color = xPol
                            .Bold = True
                        End With
                        ' Avancer la recherche
                        curPos = xDeb + xLgrTexte
                    End If
                End If
            Next F
        End If
    Next xCell
    
    MsgBox "Terminé"
End Sub

Function Fct_ChercheCouleurMots(xMot As String, listeMotsRange As Range, ws As Worksheet) As String
    Dim xCell As Range
    Dim colHeader As String
    
    Fct_ChercheCouleurMots = ""
    For Each xCell In listeMotsRange
        If Trim(UCase(xMot)) = Trim(UCase(xCell.Value)) Then
            ' Prend l’en-tête ligne 1 de la même colonne
            colHeader = ws.Cells(1, xCell.Column).Value
            Fct_ChercheCouleurMots = colHeader
            Exit Function
        End If
    Next xCell
End Function
Cliquez pour agrandir...
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- 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