Autres Mise en couleur de cellules si précence d'un d'un commentaire précis sur la même ligne

[Chrige]

Bonjour à tous
Je souhaiterais mettre en couleur des cellules suivant la présence ou pas d'un mot dans des commentaires sur la même ligne
J'ai essayé toute ma matinée, je viens donc à l'aide
Pour plus de clarté j'ai réalisé un petit exemple de mon fichier bien trop gros pour être posté.

Quelques explications :
Le mot recherché est en F1
Les cellules à mettre en vert (par exemple) sont ceux des colonnes C et D
Les cellules contenant les commentaires se trouve dans les colonnes J à V.

Je ce que je souhaite réalisé concrètement, c'est mettre en vert les cellules C4 et D4 si dans les cellules le mot placé en F1 se trouve dans les commentaires des cellules dans la plage J4 à V4, ceci à partir de la ligne 4 et jusqu'à la fin de mon fichier. Sinon mettre en gris C4 et D4.

Il faut que le mot recherché soit de préférence exactement le même. ex "jean" ne soit pas reconu dans "jeanjean"
Merci par avance

 

[Chrige]

Bonjour Sylvanu, Job75 et tout le Forum

Merci beaucoup pour cette macro
C'est tout à fait ce que je souhaitais
Et elle fonctionne très bien
Le seul hic, c'est le temps de traitement !!
Près de 2mn !
C'est bien long devant un écran à ne rien faire
Je m'y attendais un peu

Je ne sais pas si c'est stupide
Mais dans mes colonnes de J à V, il y a plus de cellules vide ou sans commentaires que de cellules avec des commentaires
Est-ce qu'il serait crédible de faire un test pour exclure toutes les cellules sans commentaires ??

 

[sylvanu]

Bonjour,
Oui en modifiant un petit peu le IF :

 If Chaine <> "" Then
                    Chaine = Cells(L, C).NoteText
                    If " " & Chaine & " " Like "* " & Nom & " *" = True Then
                        Flag = 1: Exit For
                    End If
              End If

De cette façon si la cellule est vide on ne regarde pas le commentaire.
Mais ça suppose qu'une cellule vide n'a pas de commentaire.

 

[job75]

Bonjour Chrige, sylvanu,

Pour étudier uniquement les cellules c contenant un commentaire :

For Each c In [J:V].SpecialCells(xlCellTypeComments)
'---'
Next

A+

 

[Chrige]

Merci Sylvanu,
C'est aussi long dans mon fichier
Mais il y a un problème
Cela ne fonctionne pas, même dans cet exemple

Merci Job75
Mais là je pense qu'il faut changer toute la boucle, Non ??

 

[job75]

Voyez le fichier joint et la macro du bouton :

Option Compare Text 'la casse est ignorée, mettre en commentaire pour qu'elle soit respectée

Sub Couleurs()
Dim nom$, c As Range, chaine$
nom = [F1]
Application.ScreenUpdating = False
Range("C2:D" & Rows.Count).Interior.Color = RGB(192, 192, 192) 'gris
Range("J2:V" & Rows.Count).Interior.Color = vbYellow 'jaune
For Each c In [J:V].SpecialCells(xlCellTypeComments)
    chaine = c.NoteText
    If InStr(" " & chaine & " ", " " & nom & " ") Or _
        InStr(vbLf & chaine & vbLf, vbLf & nom & vbLf) Then _
            Cells(c.Row, 3).Resize(, 2).Interior.Color = vbGreen 'vert
Next
Rows(ActiveSheet.UsedRange.Rows.Count + 1 & ":" & Rows.Count).Interior.ColorIndex = xlNone 'RAZ en dessous
End Sub

On teste pour savoir si le nom est encadré par des espaces ou par des renvois à la ligne.

Cette manière de faire n'est pas forcément la plus rapide.

A+

 

[job75]

La macro précédente est quand même très rapide.

J'ai testé en copiant les lignes 2:27 sur 5200 lignes : la macro s'exécute en 0,64 seconde chez moi.

 

[Chrige]

Bonsoir Job75
Merci pour cette macro, 64 secondes au lieu de 2mn, cela promet
Je vais essayé ce soir dans mon fichier

 

[job75]

Bonsoir, combien avez-vous de lignes et combien de commentaires à traiter ?

 

[job75]

Par ailleurs pour connaître votre ordi quelle durée avez-vous sur le fichier de mon post #21 ?

 

[Chrige]

Bonsoir Job75

Chez moi 20 secondes dans mon fichier de plus de 2000 lignes, c’est fulgurant !!!

Par contre j’ai plusieurs problèmes

1er problème
Ce n’est pas toutes les cellules de la colonne C et D qui doivent revenir en gris
Mais seulement celles ou il y a des cellules avec commentaires (J :V)
Car j’ai des cellules avec d’autres couleurs dans ces 2 colonnes

2ème problème
J’ai souhaité rajouter d’autres actions (Attributs supplémentaires)
(Voir la macro modifiée)
Mais si je rajoute ces actions supplémentaires, elles se réalisent sur toutes les lignes où il y a des commentaires et non pas sur celles en rapport avec le nom !!

Comme pour la remise en gris, ces attributs supplémentaires doivent revenir à la normale en cas de changement de nom en F1

 

[job75]

Chez moi 20 secondes dans mon fichier de plus de 2000 lignes, c’est fulgurant !!!

Votre ordi se traîne mais vous n'avez pas répondu aux questions de mes posts #23 et #24 !!!

Pour le 1er problème voyez les fichiers (2) joints et cette macro :

Option Compare Text 'la casse est ignorée, mettre en commentaire pour qu'elle soit respectée

Sub Couleurs()
Dim nom$, r As Range, chaine$
nom = [F1]
Application.ScreenUpdating = False
With Range("J2:V" & Rows.Count)
    .Interior.Color = vbYellow 'jaune
    Set r = .SpecialCells(xlCellTypeComments)
End With
Intersect(Range("C2:D" & Rows.Count), r.EntireRow).Interior.Color = RGB(192, 192, 192) 'gris
For Each r In r
    chaine = r.NoteText
    If InStr(" " & chaine & " ", " " & nom & " ") Or _
        InStr(vbLf & chaine & vbLf, vbLf & nom & vbLf) Then _
            Cells(r.Row, 3).Resize(, 2).Interior.Color = vbGreen 'vert
Next
Rows(ActiveSheet.UsedRange.Rows.Count + 1 & ":" & Rows.Count).Interior.ColorIndex = xlNone 'RAZ en dessous
End Sub

Chez moi sur 5200 lignes elle s'exécute en 0,7 seconde !!!

Pour le 2ème problème c'est un autre sujet, ouvrez une nouvelle discussion.

 

[Chrige]

Bonjour Job75 et tout le Forum



Merci à nouveau pour votre aide



En réponse à vos 2 questions :

- J’ai actuellement 1784 commentaires dans mes colonnes (J :V)

Et mon fichier a en tout 2025 lignes

- Le temps de traitement sur votre fichier (post21) est de 6.23 secondes



Oui le micro ou j’utilise ce fichier se traine !!





Je pense que j’ai trouvé la solution à ma 2ème question
Vous me direz si mon code est cohérent ?
En tout cas cela fonctionne bien



Pour le rétablissement de mes cellules en l’état habituel
Je suis obligé de le faire en 2 fois
Je ne sais pas si on peut faire mieux et plus rapide ?

Intersect(Range("C2:D" & Rows.Count), r.EntireRow).Interior.Color = RGB(192, 192, 192)

With Intersect(Range("B2:B" & Rows.Count), r.EntireRow)
    .Font.FontStyle = "Normal"
    .Font.Size = 10
    .Interior.Pattern = xlSolid
End With