XL 2016 VBA - Colorer toutes les occurences de mots dans une même ligne ou cellule

[rjm]

Bonjour.

Une feuille contient la liste de tous les mots clés à trouver (feuille Sh01): liste évolutive.
Dans une autre feuille (Sh02), j'essaie de colorer tous les mots identiques aux mots clés de la Sh01.

Problème: le mot clé peut apparaître 2 ou 3 fois dans une même ligne (ou cellule), et c'est le premier mot trouvé qui est coloré. Le 2è et 3è mot restent intact.

Code utilisé (cf. PJ):

Sub colorer()
Dim i, a, ligne, derLigne1, derLigne2
derLigne1 = Sh01.Cells(Rows.Count, 1).End(xlUp).Row 'feuille liste
derLigne2 = Sh02.Cells(Rows.Count, 1).End(xlUp).Row 'feuille draft


For i = 1 To derLigne2 'feuille Sh02
a = UCase(Sh02.Cells(i, 1))

For j = 2 To derLigne1 'feuille Sh01, commence à la 2è ligne
ligne = UCase(Sh01.Cells(j, 1))

If InStr(a, ligne) > 0 Then
Sh02.Cells(i, 1).Characters(Start:=InStr(a, ligne), Length:=Len(ligne)).Font.Color = vbRed
End If
Next j
Next i
End Sub


Quelq'un a-t-il une idée?

D'avance, merci.

 

[laurent3372]

Bonjour,

Voici ma solution.
Je me suis amusé au passage à utiliser des noms de variables plus parlants qui améliorent la lisibilité du code.

Cordialement,
--
LR

 

[BOISGONTIER]

Bonjour,

Sub colorier()
    Set f1 = Sheets("texte")
    Set f2 = Sheets("liste")
    derLigne1 = f1.Cells(Rows.Count, 1).End(xlUp).Row
    derLigne2 = f2.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To derLigne1
        ligneAnalysée = Replace(Replace(Replace(UCase(f1.Cells(i, 1)), ".", " "), ",", " "), "'", " ")
        For j = 2 To derLigne2
            mot = UCase(f2.Cells(j, 1))
            mots = Split(ligneAnalysée, " ")
            p = 1
            For k = LBound(mots) To UBound(mots)
              If mot = mots(k) Then f1.Cells(i, 1).Characters(Start:=p, Length:=Len(mot)).Font.Color = vbRed
              p = p + Len(mots(k)) + 1
            Next k
        Next j
    Next i
End Sub

http://boisgontierjacques.free.fr/fichiers/Cellules/ColorerMots.xls

ligneAnalysée = Replace(Replace(Replace(UCase(f1.Cells(i, 1)), ".", " "), ",", " "), "'", " ") gère la ponctuation (.,')


Boisgontier

 

[jmfmarques]

Bonjour
Bien malin qui pourra répondre avec précision tant que ne seront pas levées certaines ambiguïtés :
1)

Problème

: le mot clé peut apparaître 2 ou 3 fois dans une même ligne (ou cellule), et c'est le premier mot trouvé qui est coloré. Le 2è et 3è mot restent intact.

Le "premier mot" de quoi ? de chaque cellule ? de chaque ligne ? de l'ensemble des lignes ?
2) comment distingue-t-on les "mots" ? A ma connaissance et sans autre précision, les espaces ne sont pas les seuls séparateurs valables de "mots".

 

[patricktoulon]

bonjour
on peut s'amuser un peu si tu veux 😉
met tes mots en couleur et avec des font différents dans ta sheets("liste") et teste ceci

Option Explicit
Sub colorer()
   Dim c As Range, cel As Range, i&, listemot As Range
    With Sheets("liste"): Set listemot = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)): End With
    Application.ScreenUpdating = False
    With Sheets("Draft").UsedRange: .Font.Color = vbBlack: .Font.Bold = False: .Font.Name = "Courier New": End With
    For Each c In listemot.Cells
        With Sheets("Draft").UsedRange
            For Each cel In .Cells
                If InStr(cel.Value, c.Text & " ") > 0 Then
                    For i = 1 To Len(cel.Value)
                        If Mid(cel.Value, i, Len(c.Text & " ")) = c.Text & " " Then
                            With cel.Characters(Start:=i, Length:=Len(c.Text & " ")).Font
                                .Color = c.Font.Color
                                .FontStyle = "Gras italique"
                                .Name = c.Font.Name
                                'etc....
                                'etc....
                            End With
                        End If
                    Next
                End If
            Next
        End With
    Next
End Sub

vue du sheets liste

démo du résultat

 

[patricktoulon]

re
et pour lever toute ambiguïté (confusion entre un mot et la dernière syllabe d'un mot )
étant donné que je n'utilisais que l'espace suivant pour chopper aussi le premier left(1)
je modifie ce point et donc
je teste le premier mot avec espace suivant d'abords et le mot entre espace ensuite dans la boucle

Option Explicit
Sub colorer()
    Dim c As Range, cel As Range, i&, listemot As Range
    With Sheets("liste"): Set listemot = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp)): End With
    Application.ScreenUpdating = False
    With Sheets("Draft").UsedRange: .Font.Color = vbBlack: .Font.Bold = False: .Font.Name = "Courier New": End With
    For Each c In listemot.Cells
        With Sheets("Draft").UsedRange
            For Each cel In .Cells
                If InStr(cel.Value, c.Text & " ") > 0 Then
                    For i = 1 To Len(cel.Value)
                        If Left(cel.Value, Len(c.Value & " ")) = c.Text & " " Then
                            With cel.Characters(Start:=1, Length:=Len(c.Text & " ")).Font
                                .Color = c.Font.Color
                                .FontStyle = "Gras italique"
                                .Name = c.Font.Name
                            End With
                        End If
                       
                        If Mid(cel.Value, i, Len(" " & c.Text & " ")) = " " & c.Text & " " Then
                            With cel.Characters(Start:=i, Length:=Len(" " & c.Text & " ")).Font
                                .Color = c.Font.Color
                                .FontStyle = "Gras italique"
                                .Name = c.Font.Name
                                'etc....
                                'etc....
                            End With
                        End If
                    Next
                End If
            Next
        End With
    Next
End Sub

 

[jmfmarques]

mot avec espace suivant d'abords et le mot entre espace

Et les mots dont la dernière lettre est suivie d'une ponctuation ? Et ceux précédés ou suivis d'un tiret ? Et ceux (ce seront les pires) qui suivent une apostrophe ?

 

[patricktoulon]

re
bonjour @jmfmarques
1° suivi d'un tiret c'est un mot composé ce n'est donc pas un des mot recherché c'est une syllabe
(sauf language spécial"ex:informatique")a adapter donc au besoins (texte particulier)

2°la ponctuation c'est quoi "?!:.,etc..) ben tu les ajoute et pourquoi pas faire un select case

et pourquoi pas faire un regex global de replacement et colorer tout les matchs pointés en un seul coup
bref solutions il y a 😉

 

[jmfmarques]

Bien dit ("dit", hein ...). On en reparlera lorsque tu auras déclaré avoir "fini". 😎
PS :

suivi d'un tiret c'est un mot composé ce n'est donc pas un des mot recherché c'est une syllabe

Ah .... une "syllabe", hein ... hein ??? (inquiétant).

 

[rjm]

Bonjour BOISGONTIER

Il me semble que ta solution a été codée naturellement !
J'aimerais bien avoir cette logique un jour.

Mille merci,

 

[rjm]

Bonjour à tous.

Merci bien pour toutes vos réponses.
J'ai eu beaucoup de plaisir à les lire vos codes et cela m'a bien aidé en tout cas.

Cordialement.