Discussion :

[Tchapeto]

Bonjour a tous,

Quelle serait la syntaxe pour cette fonction :

Si dans la colonne B il existe des cellules dont la couleur est RGB(255, 255, 102)

Alors j'enleve le fond de ces cellules

Fin du si

Merci d'avance pour votre aide

[Qwazerty]

Salut

Quel est le problème ? même pas un essai de code ?

Code :

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

1
2
3
4
5
6
7
8
9
10
Sub moinscouleur()
Dim TheCell As Range
 
    Feuil1.Range("C2").Interior.Color = RGB(255, 255, 102)
 
    For Each TheCell In Feuil1.Columns(3).Cells
        If TheCell.Interior.Color = RGB(255, 255, 102) Then TheCell.Interior.ColorIndex = xlColorIndexNone
    Next
 
End Sub

++
Qwaz

[Tchapeto]

Ha si si bien sur j'avais essaye evidemment

Code :

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

1
2
3
4
5
If Columns("G").Interior.Color = RGB(255, 255, 102) Then
 
    Columns("G").Clear
 
End If

Merci de ta reponse je vais l'essayer

[Qwazerty]

Salut

Si tu utilises Clear, c'est toute la mise en forme et le contenu de ta cellule qui sera remise par défaut pas uniquement la couleur. Après tout dépend ce que tu recherche exactement.

J'ai fait une boucle sur la totalité des cellule de la colonne... ce qui ne devrait jamais être fait mais je n'ai pas assez d'information pour faire mieux, les cellules en question ont elles toutes un contenu ?

Si les cellules risquent d'être vide mais en couleur tu peux faire comme cela.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub moinscouleur()
Dim TheCell As Range
 
    'Place une couleur pour faire un teste de la boucle qui suit
    Feuil1.Range("B2").Interior.Color = RGB(255, 255, 102)
 
    'UsedRange retourne une selection de range qui englobe toute les cellules ayant subit une modification
    'On utilise ici UsedRange pour connaitre la ligne la plus basse qui est utilisée dans le fichier
    'L'avantage avec UsedRange est que si la cellule est vide, elle sera tout de même prise en considération
 
    For Each TheCell In Feuil1.Range("B1", Feuil1.Cells(Feuil1.UsedRange.Rows.Count, "B")).Cells ' Feuil1.Columns(3).Cells
        If TheCell.Interior.Color = RGB(255, 255, 102) Then TheCell.Interior.ColorIndex = xlColorIndexNone
    Next
End Sub

Si les cellules ont forcement un contenu, il y a des solutions plus élégantes car dans le code précédent si la colonne B s'arrête à la ligne 5 mais que la colonne G va jusqu'à la ligne 4000, alors la boucle se fera de B1 à B4000... ce qui n'est pas très efficient.


Voila un code qui fonctionnera à condition que les cellules de la colonne B aient un contenu, du moins celles qui ont le format colorimétrique que tu souhaites modifier.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub moinscouleur()
Dim TheCell As Range
 
    'Place une couleur pour faire un teste de la boucle qui suit
    Feuil1.Range("B2").Interior.Color = RGB(255, 255, 102)
 
    'On boucle de B1 jusqu'à la dernière cellule de la colonne B ayant une cellule non vide 
    For Each TheCell In Feuil1.Range("B1", Feuil1.Cells(Feuil1.Rows.Count, "B").End(xlUp)).Cells
        If TheCell.Interior.Color = RGB(255, 255, 102) Then TheCell.Interior.ColorIndex = xlColorIndexNone
    Next
End Sub

++
Qwaz

[patricktoulon]

Bonjour
je crois me souvenir que ces dernier mois une discussion similaire en a fait l'object
je n'en suis pas sur mais je crois que c'est Mercatog qui avais répondu

il était question dans sa réponse de "find format"

en tapant ce pseudo dans la recherche tu devrais retrouver ce post très facilement

[Qwazerty]

Salut

Ah oui, je n'y avait pas pensé.
en effet lorsqu'on fait un Ctrl+F pour faire une recherche dans un document Excel, il est possible de rechercher des cellules ayant un format particulier.
Si tu ne retrouve pas le poste en question, un petit enregistrement de macro devrait bien dégrossir le travail Tchapeto.

++
Qwaz

[Marc-L]

Bonjour,

depuis la version 2007, c'est aussi possible via un simple filtre …



_____________________________________________________________________________________________________
Je suis Charlie, Bardo, Sousse

[patricktoulon]

re
sur MSDN c'est ici https://msdn.microsoft.com/fr-fr/lib.../ff837616.aspx
bon moi je l'ai essayé et j'ai un message d'ereeur "variable non defini dans la ligne "find"
sinon MarL a suggéré les filtres
un exemple

Code :

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

1
2
3
Dim derlig As Long
 derlig= Cells(Cells.Rows.Count, "A").End(xlUp).Row
ActiveSheet.Range("A2").Resize(derlig , 1).AutoFilter Field:=2, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor

filtre les ligne ou il y a des cellule avec la couleur rouge(chez moi ne fonctionne pas!!)
je continu ma recherche
après test celle ci fonctionne

Code :

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

1
2
3
Sub test()
ActiveSheet.Cells.AutoFilter Field:=3, Criteria1:=RGB(255, 0, 0), Operator:=xlFilterCellColor
End Sub

si je remplace "cells" par "range ("C1:C10")" ca plante "méthode range a échoué"

pareil si je met "columns(3)"

pareil si je met column(3).cells"
je n'ai pas d'explication si une âme charitable veux bien intervenir

edit:
j'en ai trouvé une autre
mais c'est pire je n'ai pas d'erreur mais j'ai rien du tout

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
Sub FindYellowCells()
   Dim YellowCell As Range, FirstAddress As String
   Const IndicatorColumn As String = "B"
   'Columns(IndicatorColumn).ClearContents
   '   The next code line sets the search for Yellow color... the next line after it (commented out) searches
   '   for the ColorIndex 6 (which is usually yellow), so use whichever code line is applicable to your situation
   'Application.FindFormat.Interior.Color = vbYellow
   Application.FindFormat.Interior.ColorIndex = 6
   Set YellowCell = Range("b1:b20").Find("*", After:=Cells(1, 2), SearchFormat:=True)
   If Not YellowCell Is Nothing Then
     FirstAddress = YellowCell.Address
     Do
       Cells(YellowCell.Row, 1).Value = "X"
       Set YellowCell = Range("b1:b20").Find("*", After:=YellowCell, SearchFormat:=True)
       'If YellowCell Is Nothing Then Exit Do
     Loop While FirstAddress <> YellowCell.Address
   End If
 End Sub

[eriiic]

Bonjour,

avec .find :

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
Sub suppCouleur()
    Dim c As Range
    Range("B2,B7,B11,C5").Interior.Color = 255 ' pour test
 
    Application.FindFormat.Interior.Color = 255
    With Columns("B:B")
        Set c = .Find(What:="", SearchFormat:=True)
        'Debug.Print
        If Not c Is Nothing Then
            Do
                'Debug.Print c.Address
                c.Interior.Color = xlNone
                Set c = .Find(What:="", After:=c, SearchFormat:=True)
            Loop While Not c Is Nothing
        End If
    End With
End Sub

eric

[patricktoulon]

Bonjour et merci eric!

comme dans mes exemple je n'utilisais pas findnext l'argument after devait aussi être a jour
je devais être fatigué hier soir

Code :

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

After:=c

'c doit être la précédente occurrence
purée j'ai honte

[eriiic]

Re,

En fait le .findnext n'a pas l'air de fonctionner terrible avec SearchFormat:=True, enfin je n'ai pas réussi.
D'où ré-utilisation de .find avec After:=c, SearchFormat:=True

eric

[zenpbb]

Bonjour,
Pourquoi s'arrêter au Find et pas essayer Remplacer ?
Via l'enregistreur de macros, c'est du tout cuit!

[patricktoulon]

re
en fait le find next ne fonctionne pas du tout dans ce cas de critere visiblement
meme en ayant utiliser une variable pour le after

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
With Columns("B:B")
    Set c = .Find(What:="*", SearchFormat:=True)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Set first = c
        Do
            'Debug.Print c.Address
                c.Interior.Color = xlNone
                Set c = .FindNext(What:="*", After:=first, SearchFormat:=True)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
End Sub

c'est quand même curieux

[SfJ5Rpw8]

Bonjour,
Pourquoi s'arrêter au Find et pas essayer Remplacer ?
Via l'enregistreur de macros, c'est du tout cuit!

ben oui

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
 Application.FindFormat.Clear
    With Application.FindFormat.Interior
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 255, 102)
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
 
    Application.ReplaceFormat.Clear
    With Application.ReplaceFormat.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
   Feuil1.Range("B:B").Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True

[patricktoulon]

J ai essayé avec l enregistreur et en aucun cas avec 2007 j obtiens un code similaire de près ou de loin

[SfJ5Rpw8]

J ai essayé avec l enregistreur et en aucun cas avec 2007 j obtiens un code similaire de près ou de loin

pas loin le code issue d'un enregistrement 2007:

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
Sub Macro3()
'
' Macro3 Macro
'
 
'
 
    With Application.FindFormat.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Application.ReplaceFormat.Interior
        .Pattern = xlNone
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End Sub

Procédure :
Bandeau Acceuil/Rechercher et Sélectionner/Remplacer
ne rien mettre dans Rechercher et remplacer
Cliquer sur le bouton Options >>>
puis modifier les couleur de fond pour le format de la zone de recherche et de la zone de remplacement (Attention il faut absolument faire une modification pour qu'excel enregistre quelque-chose ! le mieux et d'effectuer une première recherche/remplace avec d'autre couleurs avant de débuter l'enregistrement.)

cliquer sur Remplacer tout...


et voilà le code obtenu.. j'ai juste rajouter un ClearFormat pour ne pas dépendre des précédente recherche/remplace ...

[patricktoulon]

autant pour moi Merci bbil

après nettoyage du code ca donne ca

Code :

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

1
2
3
4
5
6
Sub Macro2()
   With Application.FindFormat.Interior: .Color = 255: End With
    With Application.ReplaceFormat.Interior: .Color = xlnone: End With
    Cells.Replace What:="", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=True, ReplaceFormat:=True
End Sub

je n'utilisais pas remplacer mais rechercher
c'est assez intéressant dans le sens ou si on peut en obtenir le range(.....).address ca rend pratiquement caduque la fonction find/findnext


je vais faire des essais

[eriiic]

With Application.FindFormat.Interior: .Color = 255: End With
Restons simple

Code :

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

Application.FindFormat.Interior.Color = 255

eric

[patricktoulon]

je sais c'est bizarre

mais chez moi sens le with ca plante