Macro mise en forme cellule

Bonjour,

Je cherche a faire une macro qui mette des cellules en fond de couleur bleu chaque fois qu'elle contient un texte (3 textes différents)

Pour l'instant je le fais a la main mais c'est assez long

la mise en forme conditionnelle ne me convient pas car j'ai besoin qu'une fois la cellule mise en fond de couleur elle le reste même si la cellule ne contient plus le texte.

je ne maitrise pas VBA , quelqu'un peut il m'aider

Je met une extraction de mon fichier le principe est que l'on rentre une date prévue dans la colonne F devant RC ou RD et elle se planifie a droite par un RCp ou RDp.

Comme la date peut changer j'aimerais que a chaque fois que je modifie la date il mette en fond bleu les cellules qui contienne RCp ou RDp et qu'elle le reste .

Merci de votre aide

Bonjour ,

je ne suis pas sûr d'avoir bien saisi mais essaye sa :

Private Sub Worksheet_Change(ByVal Target As Range)
    If Range("E" & Right(Target.Address, 2)).Interior.ColorIndex <> 23 Then
        If Range("E" & Right(Target.Address, 2)).Value = "RCp" Or Range("E" & Right(Target.Address, 2)).Value = "RCp" Then
            Range("E" & Right(Target.Address, 2)).Interior.ColorIndex = 23
        End If
    End If
End Sub

Lors d'un changement de valeur sur la feuille , cela modifiera la couleur de fond de la colonne E de la ligne associé en bleu si la valeur et RCp ou RDp ( si la case était bleu elle le reste quelque soit le changement)

cordialement

Ah merci mais je n'arrive pas a lancer la macro sans doute un problème de syntaxe

quand je créée une macro je la nomme bleu et j'ai ça

Sub bleu()

End Sub

Je colle ta macro mais j'ai 2 Sub et private sub je n'arrive pas a la créée

si j’enlève Sub bleu elle ne s'enregistre pas que dois je faire

Je me suis mal exprimer

mais la couleur qui doit changer n'est pas la colonne E mais dans la grille de droite la ou va s'inscrire le terme RCp ou RDp

chaque fois qu'on renseigne une date dans la colonne E un RCp ou RDp apparait dans la grille en fonction de la date grace a des formules

re ,

regarde le fichier joint

cordialement

Ah merci ça marche bien

j'ai changer la couleur mais j'ai des questions sur ton code

Private Sub Worksheet_Change(ByVal Target As Range)
For i = 7 To 179
    If Cells(Right(Target.Address, 2), i).Interior.ColorIndex <> 33 Then
        If Cells(Right(Target.Address, 2), i).Value = "RCp" Or Cells(Right(Target.Address, 2), i).Value = "RDp" Then
            Cells(Right(Target.Address, 2), i).Interior.ColorIndex = 33
        End If
    End If
Next i
End Sub

que signifie

For i = 7 To 179 

S'agit'il des N° de colonne ?

comment faire pour la macro ne s'applique que dans la grille de J10 à IW25 par exemple ?

E quelle différence entre Private Sub et sub , car la Macro n'apparait pas dans les noms de macros (modules) mais dans Worksheet ?

alors ,

For i = 7 To 179 

=> sa correspond au parcours des colonnes (7 pour J et 179 pour IW) : si tu en ajoute , il faudra l'incrémenter d'autant

Faire un parcours de J10 à IW25 est parfaitement possible en incluant une seconde boucle . Mais cette sélection est-elle fixe ou dépend de la ligne modifié ? Faut -il faire sur toute les lignes ?

La macro est placé dans le worksheet pour pouvoir être lancé à chaque modification sur la feuille , si tu veut la lancer manuellement il faut la mettre dans un module (et enlever le private )

Le private signifie qu'elle ne peut pas être lancé "à la main" , il l’appeler depuis une autre macro ou de manière automatique

ramoutch a écrit :

Faire un parcours de J10 à IW25 est parfaitement possible en incluant une seconde boucle . Mais cette sélection est-elle fixe ou dépend de la ligne modifié ? Faut -il faire sur toute les lignes ?

En fait le fichier joint était un extrait , dans le complet il y'a beaucoup plus de lignes

Comment fait t'on pour rajouter une boucle ?

peut t'on mettre des lettres a la places de N° de colonne ?

pour le seconde boucle : (modifie les valeurs min et max de j pour que sa colle à ton fichier )

Private Sub Worksheet_Change(ByVal Target As Range)
dim i,j as integer

for j =10 to 25
For i = 7 To 179
    If Cells(j, i).Interior.ColorIndex <> 33 Then
        If Cells(j, i).Value = "RCp" Or Cells(j, i).Value = "RDp" Then
            Cells(j, i).Interior.ColorIndex = 33
        End If
    End If
Next i
next j
End Sub

sinon on peut mettre de lettres mais pas faire de boucle avec donc pas très utile dans ton cas

Par contre il est possible de créer une variable prenant comme valeur la dernière colonne remplie de ton tableau , dans ce cas tu n'aura pas à la modifier (c'est aussi faisable pour le nombre de ligne si tu souhaite )

Super encore merci pour ton aide

j'ai finis par mettre cela

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j As Integer

For j = 10 To 25
For i = 10 To 260
    If Cells(j, i).Interior.ColorIndex <> 33 Then
        If Cells(j, i).Value = "RCp" Or Cells(j, i).Value = "RDp" Then
            Cells(j, i).Interior.ColorIndex = 33
        End If
    End If
Next i
Next j
End Sub

Faut que je me perfectionne en macro

En macro

i est toujours une colonne et j toujours une ligne ?

petite amélioration du code avec un compteur pour le nombre de ligne et de colonne

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i, j As Integer
Dim nbligne, nbcol As Integer
nbligne = 10
nbcol = 10

While IsEmpty(Cells(8, nbligne).Value) = False
    nbligne = nbligne + 1
Wend
nbligne = nbligne - 1

While IsEmpty(Cells(nbcol, 1).Value) = False
    nbcol = nbcol + 1
Wend
nbcol = nbcol - 1

For j = 10 To nbcol
For i = 10 To nbligne
    If Cells(j, i).Interior.ColorIndex <> 33 Then
        If Cells(j, i).Value = "RCp" Or Cells(j, i).Value = "RDp" Then
            Cells(j, i).Interior.ColorIndex = 33
        End If
    End If
Next i
Next j

par contre il faut que ton fichier reprenne la même structure que ton exemple (première valeur en ligne 10 ,...) et il faut au moins une ligne vide après les dernière données

les lignes et colonnes s'appellent i et j car j'ai l'habitude de nommer ainsi mes variables , tu peut leurs donner le nom que tu veut ^^

encore une question j'essaye de doubler la macro avec une autre couleur pour d'autre valeur mais comment dois structurer ma macro

J'ai fait comme cela mais ça coince

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i, j As Integer

For j = 10 To 25
For i = 10 To 260
    If Cells(j, i).Interior.ColorIndex <> 33 Then
        If Cells(j, i).Value = "RCp" Or Cells(j, i).Value = "RDp" Then
            Cells(j, i).Interior.ColorIndex = 33
        End If
    If Cells(j, i).Interior.ColorIndex <> 4 Then
        If Cells(j, i).Value = "RCr" Or Cells(j, i).Value = "RDr" Or Cells(j, i).Value = "RDpr" Then
            Cells(j, i).Interior.ColorIndex = 4
        End If

    End If
Next i
Next j
End Sub

Il me dit Next sans for comment dois faire

il te manque un End if à la fin de la première boucle

Ok ,

la macro marche mais le temps de traitement est très long quasiment 20 sec dès que je change une date

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i, j As Integer

    For j = 10 To 797
    For i = 10 To 260
        If Cells(j, i).Interior.ColorIndex <> 33 Then
            If Cells(j, i).Value = "RCp" Or Cells(j, i).Value = "RDp" Then
                Cells(j, i).Interior.ColorIndex = 33
            End If

            End If
        If Cells(j, i).Interior.ColorIndex <> 4 Then
            If Cells(j, i).Value = "RCr" Or Cells(j, i).Value = "RDr" Or Cells(j, i).Value = "RCpr" Or Cells(j, i).Value = "RDpr" Then
                Cells(j, i).Interior.ColorIndex = 4
            End If

        End If
    Next i
    Next j
    End Sub

Pourquoi est ce aussi long ?

faut t'il faire 2 macro au lieu d'une ?

Bonjour,

Y'a t'il un moyen de rendre cette macro plus rapide

est ce qu'il vérifie sans arrêt les cellules ce qui ralentit l'exécution ?

si je ne laisse que la première partie ça dure 8 sec et si je mets les 2 c'est 20 sec

et pendant 20 sec excel n'est pas disponible , je ne peux pas laisser comme ca

Bonjour ,

Désolé pour le temps de traitement , je suis novice en vba donc mes programmes ne sont pas vraiment optimisés ...

La macro met beaucoup de temps car elle vérifie l'ensemble des données à chaque lancement , il est peut-être possible de cibler plus précisément les valeurs pouvant être modifiée afin de réduire la durée de traitement .

Donc lors d'un changement de valeurs , peut-il y avoir un changement sur n'importe quelle valeurs de la table ou juste sur un sous-ensemble (par exemple juste sur la ligne concernée ) ?

Cordialement

ramoutch a écrit :

Bonjour ,

Donc lors d'un changement de valeurs , peut-il y avoir un changement sur n'importe quelle valeurs de la table ou juste sur un sous-ensemble (par exemple juste sur la ligne concernée ) ?

Cordialement

Oui en fait quand la personne change une date (colonne F et G) cela ne changera que la ligne ( de j a IW) en question mais comment coder cela ?

car ces dates vont changer souvent et sur n'importe qu'elle ligne

Je peux éventuellement mettre une mise en forme conditionnelle pour la couleur verte car elle ne change pas mais la bleu est une prévision et change souvent

J'ai essayer la méthode

Sub exemple()

Application.ScreenUpdating = False

'Code ici ...

Application.ScreenUpdating = True 'Facultatif

End Sub

Mais c'est aussi long , peut être que ce n'est pas adapté

Bonjour ,

essaye avec sa :

Private Sub Worksheet_Change(ByVal Target As Range)

Dim i As Integer
Dim nbcol As Integer
nbcol = 10

While IsEmpty(Cells(8, nbcol).Value) = False
    nbcol = nbcol + 1
Wend
nbcol = nbcol - 1

For i = 10 To nbcol

    If Cells(Right(Target.Address, 2), i).Interior.ColorIndex <> 33 Then
        If Cells(Right(Target.Address, 2), i).Value = "RCp" Or Cells(Right(Target.Address, 2), i).Value = "RDp" Then
            Cells(Right(Target.Address, 2), i).Interior.ColorIndex = 33
        End If
    End If
    If Cells(Right(Target.Address, 2), i).Interior.ColorIndex <> 4 Then
        If Cells(Right(Target.Address, 2), i).Value = "RCr" Or Cells(Right(Target.Address, 2), i).Value = "RDr" Or Cells(Right(Target.Address, 2), i).Value = "RCpr" Or Cells(Right(Target.Address, 2), i).Value = "RDpr" Then
            Cells(Right(Target.Address, 2), i).Interior.ColorIndex = 4
        End If

    End If

Next i
End Sub

sa ne verifiera que la ligne sur laquelle il y a modification , sa devrait (en théorie ) réduire le temps de traitement

Le "screen updating" n'est pas adapté si tu n'a qu'une seule feuille

Effectivement c'est plus rapide , mais la macro ne marche que sur les première ligne

A partir de certaines lignes elle ne s’exécute pas , j'ai 800 lignes dans mon fichier test parfois plus ou moins

Bizarre , la macro devrait marché quelque soit le numéro de ligne ... je vais vérifier cela

(attention elle prend en compte uniquement la ligne modifiée)

edit : j'ai trouvé pourquoi , je corrige sa ^^

problème résolu

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim i, nb, nbcol As Integer

    nbcol = 10
    nb = Len(Target.Address) - InStr(2, Target.Address, "$")

    While IsEmpty(Cells(8, nbcol).Value) = False
        nbcol = nbcol + 1
    Wend
    nbcol = nbcol - 1

    For i = 10 To nbcol

        If Cells(Right(Target.Address, nb), i).Interior.ColorIndex <> 33 Then
            If Cells(Right(Target.Address, nb), i).Value = "RCp" Or Cells(Right(Target.Address, nb), i).Value = "RDp" Then
                Cells(Right(Target.Address, nb), i).Interior.ColorIndex = 33
            End If
        End If
        If Cells(Right(Target.Address, nb), i).Interior.ColorIndex <> 4 Then
            If Cells(Right(Target.Address, nb), i).Value = "RCr" Or Cells(Right(Target.Address, nb), i).Value = "RDr" Or Cells(Right(Target.Address, nb), i).Value = "RCpr" Or Cells(Right(Target.Address, nb), i).Value = "RDpr" Then
                Cells(Right(Target.Address, nb), i).Interior.ColorIndex = 4
            End If

        End If

    Next i
    End Sub

par contre j'ai remarqué un truc c'est qu'une case peut devenir verte même si elle était déjà bleue , c'est normal ?