Traiter en couleur des cellules épars d’un seul coup

Bonjour;

Dans cet exemple je cherche dans le texte de chaque cellule une chaine de caractère "-128-ga-"

Une cellule peut en contenir plusieurs, je constitue pour chaque cellule un string composé de son adresse et des positions dans son texte, où elle est trouvée, et je mis tous les resultat dans la colonne I,

Jusqu’à présent tout est ok et rapide

Mais en voulant colorier les cellules où cette chaine est trouvée je ne suis pas tout à fait satisfait, car c’est fait au fur et à mesure de la recherche, et si vous avez un PC lent comme le mien vous le remarquerez.

Je veux faire pour le coloriage comme c fait pour le collage en I (coller un tableau d’un coup dans un Range contigu).

Est-ce l’objet de ce qu’on appel collections de ranges ? comment les manipuler ? ou c autre chose

merci

Bonjour,

Je t'invite à relire l'astuce suivante https://www.excel-pratique.com/fr/astuces_vba/screenupdating

Leakim

Bonjour leakim

Effectivement, tellement je pensais à d'autres methodes, que j'ai oublier ça,

mais cette astuce resout parfois en partie le problème, je pense toujours à une autre méthode qui consiste à garder en memoire les resultats de la boucle dans un tableau au collection ou quelque chose comme ça, puis les coller d'un coups à la sortie de la boucle, ça ameliore encore plus dans beaucoups des cas.

Merci

@ tt

bonjour, c'est mieux d'utiliser "Find" et de colorer tout en même temps

Sub test()
     Dim c, UN As Range, aOut

     t = Timer
     s = "-128-ga-"
     Application.ScreenUpdating = False

     With ActiveSheet
          .Columns("I").ClearContents
          Set c = .Range("a2:e14")
          c.Interior.Pattern = xlNone
          ReDim aOut(1 To c.Cells.Count, 1 To 1)     'dimensioner tableau avec résultats
          Set c0 = c.Find(s, after:=.Range("E14"), lookat:=xlPart)     'recherche des cellules
          If Not c0 Is Nothing Then
               fa = c0.Address               'addresse de la première cellule
               Do
                    Set UN = Union(IIf(UN Is Nothing, c0, UN), c0)     'plages avec toutes les "bonnes" cellules
                    s1 = c0.Value: s2 = ""
                    Do
                         i = InStr(1, s1, s, 1)     'position du string
                         If i > 0 Then
                              s2 = s2 & ", " & i     'cumumer dans le  résultat
                              s1 = Left(s1, i - 1) & "_" & Mid(s1, i + 1)     'remplacer dans le string
                         End If
                    Loop While i <> 0

                    ptr = ptr + 1
                    aOut(ptr, 1) = c0.Address(0, 0) & " --> " & Mid(s2, 3)     'characteristiques de cette cellule
                    Set c0 = c.FindNext(c0)
               Loop While Not c0 Is Nothing And c0.Address <> fa

               UN.Interior.Color = RGB(WorksheetFunction.RandBetween(1, 255), WorksheetFunction.RandBetween(1, 255), WorksheetFunction.RandBetween(1, 255))
               With .Range("I1")
                    .Value = "ADRESSE-->Positions"
                    .Offset(1).Resize(ptr).Value = aOut
               End With
          End If
     End With
     MsgBox "prêt en " & Format(Timer - t, "0.00\s")
End Sub

Bonjour à tous,

Avec un simple Rechercher (Ctrl+F), puis Rechercher tout ... c'est extrêmement simple et rapide !

Bon d'accord, ça ne permet pas de briller dans les conversations mondaines, mais ça fait le job sans prise de tête

Bonjour et Merci BsAlv (Bart) et U. Milité

@ Bart je vais mettre résolu et revenir si je ne comprends pas quelque chose dans le code.

@ U. Milité : et s’il s’agit juste d’une partie exemple qui imite une partie d’un long programme que je prépare, où il n’est pas pratique de rester devant l’écran à cliquer et interagir avec les boites de dialogues de recherche et de mise en forme !! Les positions de la chaine dans la cellule et l’application de la couleur aléatoire sont aussi importantes dans ce programme, merci pour le passage. vba reste toujours utile.

re,

Après avoir décortiqué le code de Bart je partage ces qlq remarques pour ceux qui s’intéressent :

• 1- La clé du problème je pense n’est pas dans l’utilisation de find ou de boucle For mais dans l’union des Ranges par la methode Union ; La 1 ere fois j’ai pas réussis à le faire ; j copié le comment de Bart et ça donne le même résultat en rapidité soit avec boucles For ou find
• 2- J’avais utilisé une recherche qui ne revisite pas la position d’un caractère qui a participé au résultat de la séquence précédemment trouvée alors que Bart l’inclue, dans notre cas il y a pas de différence ; Mais si par exemple il s’agit de chercher ‘’aa’’ dans ‘‘aaaaaa’’ ma méthode donne 3 résultats Pour Bart donne 5 résultats

Les deux recherches sont justes, tout dépend de ce qu’on veut.

Sub aaaaaaa()
Dim s$, s1$, s2$, i%
s = "aa"
s1 = "aaaaaa"
s2 = ""
Debug.Print "s1 = " & s1 & Chr(10)
Do
i = InStr(1, s1, s, 1)
    If i > 0 Then
    s2 = s2 & ", " & i
    s1 = Left(s1, i - 1) & "_" & Mid(s1, i + 1)

    Debug.Print "i= " & i
    Debug.Print "s2 (les positions) = " & s2
    Debug.Print "s1 modifié = " & s1 & Chr(10)

    End If

'ça donne:
s1 = aaaaaa

i= 1
s2 (les positions) = , 1
s1 modifié = _aaaaa

i= 2
s2 (les positions) = , 1, 2
s1 modifié = __aaaa

i= 3
s2 (les positions) = , 1, 2, 3
s1 modifié = ___aaa

i= 4
s2 (les positions) = , 1, 2, 3, 4
s1 modifié = ____aa

i= 5
s2 (les positions) = , 1, 2, 3, 4, 5
s1 modifié = _____a

• 3- Lorsque j’ai travaillé sur un autre fichier où j’ai constitué quelques cellules avec formule de concaténation (&)

La formule find ne les a pas comptabilisées, j’ai corrigé en ajoutant le paramètre LookIn:=xlValues

@tt

re retardé,

pour le point 2

Sub aaaaaaa()
     Dim s$, s1$, s2$, i%, md$

     s = "aa"
     s1 = "aa1aa2aaaaaaaaaaaaaaaaaa"
     s2 = ""
Debug.Print "s1 = " & s1 & Chr(10)
     Do
          i = InStr(1, s1, s, 1)
          If i > 0 Then
               s2 = s2 & ", " & i
               's1 = Left(s1, i - 1) & "_" & Mid(s1, i + 1) 'tout dépend de ce qu’on veut - version 1
               s1 = Left(s1, i - 1) & WorksheetFunction.Rept("_", Len(s)) & Mid(s1, i + Len(s)) 'tout dépend de ce qu’on veut - version 2.
Debug.Print "i= " & i
Debug.Print "s2 (les positions) = " & s2
Debug.Print "s1 modifié = " & s1 & Chr(10)

          End If

     Loop While i <> 0

End Sub

point 1, concernant vitesse, la plage est trop petite pour pouvoir prendre des décisions, donc j'exagère en prenant les colonnes A:E complètement et dans la dernière ligne, il y a aussi des "-128-ga-". Donc il y a +5.000.000 cellules à contrôler

Avec Find = presque même temps qu'avec la plage précédente - 70 msec

Avec votre macro = 16 sec, le problème c'est qu'il faut lire +5.000.000 cellules individuellement.

Avec votre macro adaptée pour une lecture collective = 3,6 sec (12 sec en moins).

Donc tout dépend de la situation, si la plage est petite et le pourcentage d'occurences est assez élevé, les 2 macros peuvent s'exécuter avec une vitesse comparable.

perfect

re,

donc c'est confirmé: Find est largement mieux !

re,

largement, ici oui, compte tenu des circonstances

50 cellules sur +5.000.000, ...