Discussion :

[Sysmic76]

Bonjour à tous !

Après beaucoup de recherche sur le net je n'ai malheureusement pas trouvé mon bonheur...
J'espère que vous pourrez m'aider !

Je vous explique :

Dans un fichier excel, je met une cellule en couleur (verte RGB(0, 200, 20) ou rouge RGB(215, 20, 0)). Ce qui me permet de savoir si la ligne a déjà été traité ou non.
Normalement je fais un traitement ligne par ligne au fur et à mesure mais si il y a une erreur sur une ligne, elle passe en rouge et devra être traité lors d'une prochaine mise à jour.

Mon but est donc de rechercher les lignes dont les cellule de la colonne A est en rouge. Ca fonctionne avec une boucle qui vérifie les lignes une par une mais j'essai d'optimiser le temps de traitement alors j'ai eu l'idée de passer par un .Find mais là ça ne fonctionne plus.

Voici un bout de mon code (qui ne fonctionne pas au niveau du .Find) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
DlgAppels = Range("E" & Rows.Count).End(xlUp).Row + 1
 
        Set c = Workbooks("Appels.xlsm").Worksheets("Appels").Range("A3:A" & DlgAppels) _
        .Find((Application.FindFormat.Interior.Color = RGB(215, 20, 0)), LookAt:=xlPart, SearchFormat:=True)
 
        If Not c Is Nothing Then
 
            LigneRouge = c.Row
 
            Range("A" & LigneRouge).Select
 
            Selection.EntireRow.Columns("A:O").Copy

Voici celui qui fonctionne mais qui prend un peu trop de temps :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
'        For i = 3 To Dlg
 
'            If Range("A" & i).Interior.Color = RGB(215, 20, 0) Then
 
'                Range("A" & i).Select
'                Selection.EntireRow.Columns("A:O").Copy
 
' collage des lignes après la dernière ligne saisie dans appelsXXXX
 
'                Workbooks(AppelsXXXX).Activate
 
'                If Range("D" & Rows.Count).End(xlUp).Row + 1 Then
 
'                    Dlg = Range("E" & Rows.Count).End(xlUp).Row + 1
'                    Do While Rows(Dlg).Hidden
'                    Dlg = Dlg + 1
'                    Loop
'                    Range("A" & Dlg).Select
 
'                End If
 
' collage spécial des valeurs
 
'                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
 
' passer la cellule A en vert
 
'                Workbooks("Appels.xlsm").Activate
 
'                Selection.EntireRow.Columns("A").Interior.Color = RGB(0, 200, 20)
 
'            End If
 
'        Next

Merci à tous ceux qui auraient une idée à me proposer.

[EngueEngue]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Workbooks(AppelsXXXX).Activate

? <-Première erreur.

Si tu veux qu'on te débeugue le code merci de nous dire ou il plante

Ton code marcherait mieux avec un:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

application.screenupdating=false

en début de programme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

application.screenupdating=true

en fin de programme

[Sysmic76]

Bonjour et merci de ta réponse rapide.

Il ne s'agit qu'un bout de mon code qui est bien plus gros que ça puisqu'il effectue beaucoup de traitements.
J'utilise bien le "application.screenupdating" ce qui me fait gagner un peu de temps mais je perd facilement 5 à 10 s à vérifier les lignes une par une. J'ai déjà utilisé le .Find qui trouve les informations presque instantanément, donc un temps de traitement vraiment moindre. C'est pour ça que j'essai de l'utiliser pour chercher une cellule en couleur.

Ca ne fonctionne pas au niveau du .Find, il ne trouve pas la valeur cherchée, soit la cellule en rouge...

[parmi]

Bonjour,

Tu dois définir ton format de recherche en dehors de ta recherche comme telle

ex:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
    With Application.FindFormat.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(215, 20, 0)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    ActiveSheet.Columns("A").Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchFormat:=True).Activate
 
    MsgBox ActiveCell.Row

[Sysmic76]

Merci pour ta réponse. Je viens d'essayer ta méthode. J'ai une erreur dû au ".Activate" pour la sélection de la ligne recherchée : "Variable objet ou variable de bloc With non définie".
J'ai tenté de l'utilisé en rentrant le résultat dans une variable mais là il ne trouve pas de résultat...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
 With Application.FindFormat.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = RGB(215, 20, 0)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
        Set c = Workbooks("Appels.xlsm").Worksheets("Appels").Columns("A").Find(what:="*", LookAt:=xlPart, SearchFormat:=True)
 
        'Workbooks("Appels.xlsm").Worksheets("Appels").Range("A3:A" & DlgAppels).Find("*", LookAt:=xlPart, SearchFormat:=True).Activate
 
        If Not c Is Nothing Then
 
            LigneRouge = c.Row
 
            msgbox LigneRouge
 
        End If

[parmi]

L'erreur provient probablement du fait que tu as des cellules vides.
Le "*" de la recherche nécessite une valeur, je pense.

Si c'est le cas, tu peux peut-être utiliser une gestion d'erreur.

Il faudrait voir aussi si tes cellules colorées peuvent avoir des valeurs nulles...

[Sysmic76]

Oui la colonne qui contient les couleurs est la plus part du temps vide. J'utilise cette colonne pour ne pas trop rendre illisible le reste de la ligne.

Je vais essayer d'adapter le code en conséquence et je reviens vers toi.

Voici le bout de code que j'ai fait en conséquence.

De la façon où je l'ai fait, il voit autant les lignes qui contiennent des valeurs que les vides. Il ne voit que le fait que la cellule soit en rouge puis tourne en boucle pour les cellules suivantes.

Merci beaucoup pour l'aide que tu m'as apporté !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
DlgAppels = Range("E" & Rows.Count).End(xlUp).Row + 1
 
        Do
 
            Application.FindFormat.Interior.Color = RGB(215, 20, 0)
 
            Set c = Workbooks("Appels.xlsm").Worksheets("Appels").Range("A3:A" & DlgAppels).Find("", LookAt:=xlPart, SearchFormat:=True)
 
            If Not c Is Nothing Then
 
                LigneRouge = c.Row
 
                Range("A" & LigneRouge).Select
 
                Selection.EntireRow.Columns("A:O").Copy
 
' collage des lignes après la dernière ligne saisie dans appelsXXXX
 
                Workbooks(AppelsXXXX).Activate
 
                If Range("D" & Rows.Count).End(xlUp).Row + 1 Then
 
                    Dlg = Range("E" & Rows.Count).End(xlUp).Row + 1
                    Do While Rows(Dlg).Hidden
                        Dlg = Dlg + 1
                    Loop
                    Range("A" & Dlg).Select
 
                End If
 
' collage spécial des valeurs
 
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, skipBlanks:=False, Transpose:=False
 
' passer la cellule A en vert
 
                Workbooks("Appels.xlsm").Activate
 
                Selection.EntireRow.Columns("A").Interior.Color = RGB(0, 200, 20)
 
            End If
 
        Loop While Not c Is Nothing

[parmi]

Plutôt qu'utiliser une variable LigneRouge et sélectionner

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
LigneRouge = c.Row
Range("A" & LigneRouge).Select
Selection.EntireRow.Columns("A:O").Copy

Tu pourrais seulement écrire ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A" & c.Row & ":O" & c.Row).Copy

Bonne continuation !

[Sysmic76]

Merci pour ce conseil, j'ai encore pas mal d'améliorations de ce type a faire pour alléger un peu le code. Et il est vrai qu'on ne pense pas toujours à tout

Encore merci !!

[CodeFacile]

Bonjour,

il y a un problème dans ton code car on oucle sur la première occurence recherchée ; Je m'explique

dans une boucle find classique on fait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
 
with range (xxxx)
  set c= = .Find("toto", LookAt:=xlPart ) 
 
 If Not c Is Nothing Then
    first_row = c.Row
   Do
 
       'traitement
       Set c = .FindNext(c)
    Loop While Not c Is Nothing And <> first_row
 end if 
 
end with

sans le findnext , on boucle sur la première occurence.

Avec le findformat je n'arrive pas à trouvé l'équivalent du findnext

[PMO2017]

Bonjour,

Une piste en utilisant WorksheetFunction.

1) mettez des données dans une feuille à partir de A1 jusqu'à O15814 (par exemple)
2) quelques cellules de la colonne A devront être coloriées en rouge ( RGB(255,0,0) )
3) copiez le code suivant dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub Traitement()
Dim S As Worksheet
Dim R As Range
 
'/// Votre traitement ///
 
'### Recherche des cellules dont le fond correspond à une couleur déterminée ###
 
'--- Appel de la fonction FindCellInteriorColor
'--- Paramètre 1 : la plage à balayer
'--- Paramètre 2 : la couleur recherchée
Set R = FindCellInteriorColor(Range("A1:A15814"), RGB(255, 0, 0)) 'à adapter
 
'--- Si on obtient un résultat, on l'affiche dans une nouvelle feuille
If Not R Is Nothing Then
  Set S = Worksheets.Add
  R.Copy
  S.Paste
  Application.CutCopyMode = False
Else
  MsgBox "Aucune cellule de la couleur spécifiée n'a été trouvée"
End If
'###############################################################################
 
'/// Suite de votre traitement ///
 
End Sub
 
Function FindCellInteriorColor(InRange As Range, InteriorColor As Long) As Range
Dim R As Range
Dim C As Range
For Each C In InRange
  If WorksheetFunction.And(C.Interior.Color = InteriorColor) Then
 
    '--- On affecte le résultat dans une variable Range
    If R Is Nothing Then
      Set R = C.EntireRow.Columns("A:O")  ' à adapter
    Else
      Set R = Application.Union(R, C.EntireRow.Columns("A:O"))
    End If
    '---
 
  End If
Next C
Set FindCellInteriorColor = R
End Function

Je mets un classeur exemple pour plus de facilité.

[Sysmic76]

Bonjour,

il y a un problème dans ton code car on oucle sur la première occurence recherchée ; Je m'explique

dans une boucle find classique on fait :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
 
with range (xxxx)
  set c= = .Find("toto", LookAt:=xlPart ) 
 
 If Not c Is Nothing Then
    first_row = c.Row
   Do
 
       'traitement
       Set c = .FindNext(c)
    Loop While Not c Is Nothing And <> first_row
 end if 
 
end with

sans le findnext , on boucle sur la première occurence.

Avec le findformat je n'arrive pas à trouvé l'équivalent du findnext

Non pas de problème puisque ce que je cherchais à faire était de chercher toutes les lignes qui ont la couleur rouge en colonne A.

Le FindNext ressort le résultat du prochain c, soit la recherche d'une valeur vide (voir le .Find que j'utilise). J'ai donc dû "tricher" pour avoir l'équivalent d'un FindNext qui recherche la prochaine mise en forme de la cellule.

Après je suis d'accord que le code que je présente n'est pas forcément le meilleur mais il fonctionne et son temps d'exécution est très faible.

[CAXB30]

Non pas de problème puisque ce que je cherchais à faire était de chercher toutes les lignes qui ont la couleur rouge en colonne A.

Le FindNext ressort le résultat du prochain c, soit la recherche d'une valeur vide (voir le .Find que j'utilise). J'ai donc dû "tricher" pour avoir l'équivalent d'un FindNext qui recherche la prochaine mise en forme de la cellule.

Après je suis d'accord que le code que je présente n'est pas forcément le meilleur mais il fonctionne et son temps d'exécution est très faible.

Bonjour.
Je vous propose une variante RECHERCHE DE TOTO.docxsur la même proposition pour sortir de la boucle.