Changer la couleur d'une cellule si cellule modifiée
Bonjour,
Je reprend ici une macro de Amadéus qui fonctionne très bien pour ce que je veux faire mais comment attribuer cette macro à une colonne qui va de A2 à A500 par exemple ? En effet, ici c'est juste si la valeur de A2 change que sa couleur change ...
Merci pour votre aide,
Private Sub Worksheet_Activate()
valeur = Range("A2")
End Sub
Private Sub Worksheet_Calculate()
If Range("A2") <> valeur Then
Range("A2").Interior.ColorIndex = 3
valeur = Range("A2")
End If
End SubLoadlucas
Bonjour,
tu peux remplacer ces 2 sub par celle-ci
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("A2:A500"), Target) Is Nothing Then
nv = Target.Value
Application.EnableEvents = False
Application.Undo
If nv <> Target.Value Then
Target.Value = nv
Target.Interior.Color = vbRed
End If
Application.EnableEvents = True
End If
End SubBonjour,
Merci mais rien ne se passe ...
Merci pour votre aide,
Loadlucas
Bonjour,
La macro de h2so4 est parfaite ... compte tenu des infos que tu lui as données ... !!!
Mais tu ne changes pas tes cellules dans la Colonne A .... mais dans la Colonne D ....
Tu verras ci-joint la modif ....
P.S. en prime ... si tu saisis, dans la même cellule, deux fois le même nombre en Colonne C... la couleur disparait ...en Colonne A ...
Bonjour,
Merci
En effet, je me suis mal fais comprendre :
Ci-joint le fichier en question ..
Sur base de prix fournisseur (Colonne H & L) je prend le MIN des 2 (Colonne D) à cela j'applique un coefficient (C) calculé en fonction du PA MIN
Je calcul dès lors mon PV calculé (Colonne B)
En fonction du PA le coefficient modifie ou pas le PV (Colonne B)
C'est cette colonne (Colonne B) que je désire faire changer de couleur si le PA+Coefficient modifie le PV calculé (Colonne B)
J'espère avoir été plus précis quant à ma demande,
Encore merci
Loadlucas
Re,
Voilà qui complique bien la situation ... puisqu'il ne s'agit que de formules imbriquées qui calculent ta cellule en Colonne B ...
Il faudrait sans doute passer par Private Sub Worksheet_Calculate() ou Private Sub Worksheet_Change() qui puisse gérer la subtilité d'identifier les cellules dépendantes ...tout en conservant l'ancienne valeur ...
Dès que j'ai un moment .. je me pencherai sur ton problème ...
Bonjour,
si c'est un changement en colonne H ou L qui provoque le recalcul, voici une version adaptée.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("H2:H500,L2:L500"), Target) Is Nothing Then
nvb = Cells(Target.Row, 2)
nvt = Target.Value
Application.EnableEvents = False
Application.Undo
If nvb <> Cells(Target.Row, 2) Then
Cells(Target.Row, 2).Interior.Color = vbRed
End If
Target.Value = nvt
Application.EnableEvents = True
End If
End SubBonsoir,
C'est vraiment la colonne 2 qui change en fonction d'un coefficient ajouté si =(SI(D2<3;70%;(SI(D2<6;60%;40%))))
La macro que vous me proposez modifie la couleur dès que les valeurs dans H ou L change hors parfois le changement de prix dans H ou L n'est pas assez significatif pour que B change
exemple : si H a comme valeur 2 et change à 2,2 la valeur dans D ne changera pas et sera toujours <3 dans le coefficient d'augmentation du prix sera encore à 70% et B ne variera pas ...
Voir le fichier joint Test color change si val cellule change B.xls envoyé précédemment
C'est vraiment la colonne B qui doit changer de couleur quand le nombre de celle-ci change
Merci à vous,
Loadlucas
Bonsoir Aldo,
Ci-joint tu trouveras une proposition ...
En espèrant que cela te convienne ...
Bonsoir
Il y a une erreur dans la macro ....
Merci à vous,
Loadlucas
Loadlucas a écrit :Bonsoir
Il y a une erreur dans la macro ....
Merci à vous,
Loadlucas
Merci de préciser quelle erreur ...
et comment est-elle provoquée ...???
Bonsoir,
Dès modification des valeurs dans la colonne H ou L
... la colonne B ne change pas de couleur
Erreur 1004
la méthode range de l'objet _Worksheet a échoué :
If Intersect(Target, Range("A2:M" & i)) Is Nothing ThenMerci pour l'aide
Loadlucas
Désolé ....
J'ai oublié de recopier une ligne ...
Ci-joint la version corrigée ...
Super !
Merci ...
Je suppose que si j'ai plusieurs feuilles avec différentes catégories de produits, il faut que je crée une feuil2 pour la fonction "Option Explicit" ou que je lie la fonction à une feuil déterminée ?
J'ai plus de 400 ligne d'articles par feuille.
Je vais de B2 à B500
Sheets("Feuil2").Range("B2:B500").Value = Range("B2:B500").Valueou pas ?
Encore un grand merci
Loadlucas
Re,
Content que cela fonctionne ...
Oui tu as parfaitement compris ...
Merci ... pour tes remerciements ...
Loadlucas a écrit :Bonsoir,
C'est vraiment la colonne 2 qui change en fonction d'un coefficient ajouté si =(SI(D2<3;70%;(SI(D2<6;60%;40%))))
La macro que vous me proposez modifie la couleur dès que les valeurs dans H ou L change hors parfois le changement de prix dans H ou L n'est pas assez significatif pour que B change
exemple : si H a comme valeur 2 et change à 2,2 la valeur dans D ne changera pas et sera toujours <3 dans le coefficient d'augmentation du prix sera encore à 70% et B ne variera pas ...
Voir le fichier joint Test color change si val cellule change B.xls envoyé précédemment
C'est vraiment la colonne B qui doit changer de couleur quand le nombre de celle-ci change
Merci à vous,
Loadlucas
Bonjour,
c'est bien ce que fait la macro fournie. Je n'avais pas compris que tu voulais un changement de couleur lorsque la valeur de B ne change pas (aller du rouge au gris).
j'ai vu qu'entretemps tu as reçu une réponse qui te convient de James007 (que je salue). Je te mets quand même le code adapté qui ne nécessite pas de feuille supplémentaire.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("H2:H500,L2:L500"), Target) Is Nothing Then
nvb = Cells(Target.Row, 2)
nvt = Target.Value
Application.EnableEvents = False
Application.Undo
If nvb <> Cells(Target.Row, 2) Then
Cells(Target.Row, 2).Interior.Color = vbRed
Else
Cells(Target.Row, 2).Interior.Color = RGB(165, 165, 165)
End If
Target.Value = nvt
Application.EnableEvents = True
End If
End SubBonjour,
ça fonctionne mais ...
J'utilise une macro qui me permet de modifier le PA des fournisseurs (colonne H et L) en fonction d'un fichier reçu de ceux-ci.
La macro compare le code de l'article du fichier reçu avec le code de l'article dans mon fichier commande.
Dès qu'il match il modifie le PA s'il est différent.
Cette macro me permet de mettre à jour les PA de mes articles en fonction des fluctuassions des prix.
Ceci afin de calculer au mieux un PA correcte avec des coefficients qui se base sur le PA de l'article.
Dès que j'exécute la macro une erreur se produit :
"La méthode undo de l'objet application à échoué"
Si on modifie à la main les valeurs PA dans V ça fonctionne.
Petite précision, dans mon fichier final, j'ai ajouté des colonnes ce qui modifie les colonnes qui interagissent.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("V2:V500,Z2:Z500"), Target) Is Nothing Then
nvb = Cells(Target.Row, 15)
nvt = Target.Value
Application.EnableEvents = False
Application.Undo
If nvb <> Cells(Target.Row, 15) Then
Cells(Target.Row, 15).Interior.Color = vbRed
Else
Cells(Target.Row, 15).Interior.Color = RGB(165, 165, 165)
End If
Target.Value = nvt
Application.EnableEvents = True
End If
End SubVoici la macro de modification PA :
Sub MAJPABOISSONS()
Dim d As Object, k, n%, i%, j%, wbf$, clr&, Tpm()
Set d = CreateObject("Scripting.Dictionary")
wbf = ActiveSheet.Range("AH1")
With Workbooks(wbf).Worksheets(1)
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To n
If .Cells(i, 1) <> "" Then d(.Cells(i, 1).Value) = .Cells(i, 6)
Next i
End With
If d.Count = 0 Then Exit Sub
With ThisWorkbook.Worksheets("BOISSONS")
n = .Cells(.Rows.Count, 4).End(xlUp).Row
clr = RGB(191, 191, 191)
Application.ScreenUpdating = False
For i = 3 To n
If .Cells(i, 4).Value <> "" Then .Cells(i, 22).Interior.Color = clr
Next i
clr = RGB(255, 192, 0)
For i = 3 To n
k = .Cells(i, 4)
If d.exists(k) Then
If CDbl(d(k)) <> .Cells(i, 22) Then
.Cells(i, 22) = CDbl(d(k))
.Cells(i, 22).Interior.Color = clr
j = j + 1: ReDim Preserve Tpm(2, j)
Tpm(0, j) = k: Tpm(1, j) = .Cells(i, 7): Tpm(2, j) = .Cells(i, 22)
End If
End If
Next i
End With
If j = 0 Then Exit Sub
Tpm(0, 0) = "CODE": Tpm(1, 0) = "Désignation": Tpm(2, 0) = "Prix modifié"
With Worksheets("CHECK BOISSONS")
.UsedRange.Clear
With .Range("A1:C" & j + 1)
.Value = WorksheetFunction.Transpose(Tpm)
.Columns(1).HorizontalAlignment = xlCenter
.Columns(2).AutoFit
.Rows(1).HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
End With
End With
End SubMerci pour vos aides,
Loadlucas
Bonjour,
sans avoir vu ton fichier, je propose la modification suivante de ton code
Sub MAJPABOISSONS()
Dim d As Object, k, n%, i%, j%, wbf$, clr&, Tpm()
Set d = CreateObject("Scripting.Dictionary")
wbf = ActiveSheet.Range("AH1")
With Workbooks(wbf).Worksheets(1)
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To n
If .Cells(i, 1) <> "" Then d(.Cells(i, 1).Value) = .Cells(i, 6)
Next i
End With
If d.Count = 0 Then Exit Sub
With ThisWorkbook.Worksheets("BOISSONS")
n = .Cells(.Rows.Count, 4).End(xlUp).Row
clr = RGB(191, 191, 191)
Application.ScreenUpdating = False
For i = 3 To n
If .Cells(i, 4).Value <> "" Then .Cells(i, 22).Interior.Color = clr
Next i
clr = RGB(255, 192, 0)
For i = 3 To n
k = .Cells(i, 4)
If d.exists(k) Then
If CDbl(d(k)) <> .Cells(i, 22) Then
.Cells(i, 22) = CDbl(d(k))
.Cells(i, 22).Interior.Color = clr
j = j + 1: ReDim Preserve Tpm(2, j)
Tpm(0, j) = k: Tpm(1, j) = .Cells(i, 7): Tpm(2, j) = .Cells(i, 22)
End If
End If
Next i
End With
If j = 0 Then Exit Sub
Tpm(0, 0) = "CODE": Tpm(1, 0) = "Désignation": Tpm(2, 0) = "Prix modifié"
application.enableevents=false
With Worksheets("CHECK BOISSONS")
.UsedRange.Clear
With .Range("A1:C" & j + 1)
.Value = WorksheetFunction.Transpose(Tpm)
.Columns(1).HorizontalAlignment = xlCenter
.Columns(2).AutoFit
.Rows(1).HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
End With
End With
application.enableevents=true
End SubBonjour,
Toujours la même erreur ...
Ci-joint un condensé de mon fichier commande et du fichier check pour être concret.
J'ai mis une seule feuille de mon fichier commande et quelques articles de celui-ci.
Pour information, dans le fichier final, il y en a pour toute les catégories de produits mais le principe d'injection de prix est le même pour chaque feuille.
Je n'ai mis que la macro pour le fournisseur FR01 à activer par le bouton au dessus de la colonne PAFR01 elle fait appel à un fichier qu'il faut ouvrir au préalable dont le nom est en AH1 (je joint également le fichier pour test).
La macro check la colonne du code fournisseur pour comparer avec le code dans le fichier commande et modifie les valeurs de la colonne PAFR01 avec changement de couleur si valeur changée pour mettre l'accent sur la modification du prix.
La macro est identique pour le PAFR02 elle fait appel à un autre fichier et check d'autres colonne pour modifier la valeur de la colonne PAFR02.
Il y a également une macro qui par le même principe ajoute le CODEFR02 en fonction du code EAN de l'article mais cette macro n'est pas dans ce fichier test.
Je voudrait donc que les cellules de New PV Normal (colonne O) change de couleur lorsque celles-ci sont affectées par la modification du PA.
Vous remarquerez que c'est la comparaison du prix minimum des 2 fournisseurs que est pris en compte (Colonne R) et qui subit le calcul du coefficient (colonne Q), TVA (colonne P) etc. pour déterminer le PV du produit.
En espérant que ces précisions me permettrons d'aboutir car c'est la dernière ligne droite de la finalisation de ce fichier.
Merci encore pour vos aides,
Loadlucas
bonjour,
essaie ceci, adaptation sur base de tes fichiers.
Sub MAJPABOISSONS()
Dim d As Object, k, n%, i%, j%, wbf$, clr&, Tpm()
Application.EnableEvents = False
Set d = CreateObject("Scripting.Dictionary")
wbf = ActiveSheet.Range("AH1")
With Workbooks(wbf).Worksheets(1)
n = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To n
If .Cells(i, 1) <> "" Then d(.Cells(i, 1).Value) = .Cells(i, 6)
Next i
End With
If d.Count = 0 Then Exit Sub
With ThisWorkbook.Worksheets("BOISSONS")
n = .Cells(.Rows.Count, 4).End(xlUp).Row
clr = RGB(191, 191, 191)
Application.ScreenUpdating = False
For i = 3 To n
If .Cells(i, 4).Value <> "" Then .Cells(i, 22).Interior.Color = clr
Next i
clr = RGB(255, 192, 0)
For i = 3 To n
k = .Cells(i, 4)
If d.exists(k) Then
If CDbl(d(k)) <> .Cells(i, 22) Then
.Cells(i, 22) = CDbl(d(k))
.Cells(i, 22).Interior.Color = clr
j = j + 1: ReDim Preserve Tpm(2, j)
Tpm(0, j) = k: Tpm(1, j) = .Cells(i, 7): Tpm(2, j) = .Cells(i, 22)
End If
End If
Next i
End With
If j = 0 Then Exit Sub
Tpm(0, 0) = "CODE": Tpm(1, 0) = "Désignation": Tpm(2, 0) = "Prix modifié"
With Worksheets("CHECK BOISSONS")
.UsedRange.Clear
With .Range("A1:C" & j + 1)
.Value = WorksheetFunction.Transpose(Tpm)
.Columns(1).HorizontalAlignment = xlCenter
.Columns(2).AutoFit
.Rows(1).HorizontalAlignment = xlCenter
.Borders.Weight = xlThin
End With
End With
Application.EnableEvents = True
End Sub