Détecter changement cellule ayant déjà une valeur

Bonjour,

j'ai ce code qui permet de colorer une cellule si elle change de valeur. Il marche très bien mais une seule chose n'est pas prise en compte : si la cellule contenait une valeur ou non. Il faudrait que ça colore s'il y a déjà une valeur dans cette cellule.

J'aimerais si possible que tout reste dans le Worksheet_Change

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Plage As Range
Set Plage = Cells

If Not Intersect(target, Plage) Is Nothing And target.Count = 1 Then
    target.Interior.Color = RGB(255, 64, 64)
End If

End Sub

Quelqu'un sait comment faire SVP?

Merci !

Bonjour,

Au moment où cette macro se déclenche, la précédente valeur (si elle existe) est déjà perdue et écrasée par la nouvelle.

Tu peux imaginer une macro qui se déclenche à l'ouverture du classeur pour stocker les valeurs actuelles dans une variable tableau hors procédure ou sur un onglet dédié... Mais je pense que ça va devenir une usine à gaz ! Quel est l'objectif final de tout ça ? S'il s'agit de repérer les modifications indésirables, ne serait-il pas préférable de protéger la plage en question (voire la feuille complète si je me réfère au code) ?

Bonjour,

en fait l'objectif est de repérer dans un tableau les cellules qui changent de valeur car ce sont des informations importantes.

Si un utilisateur passe par là et décide de changer la valeur d'une cellule, ça doit être détecté.

Mais si la cellule était déjà vide pas besoin d'alerter et de changer la couleur de la cellule

Est-ce que c'est plus clair ?

Merci en tout cas pour l'aide

Une proposition :

'Module ThisWorkbook
Private Sub Workbook_Open()
    Call AffecterValeurs
End Sub

'Module de la feuille ("Feuil1")
Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Count = 1 Then 'Intersect est inutile dans la mesure où ça concerne toute la feuille
    If LireValeurs(Target.Row, Target.Column) <> "" Then
        Application.EnableEvents = False 'Désactive les évenements (car on va écrire sur la plage sans redéclencher la macro)
        If MsgBox("La cellule contenait une valeur, êtes vous sûr de vouloir la remplacer ?", vbYesNo) = vbNo Then
            Target = LireValeurs(Target.Row, Target.Column) 'Rétabli l'ancienne valeur
        Else 'Ecrase l'ancienne valeur
            Target.Interior.Color = RGB(255, 64, 64) 'Applique une couleur rouge
            Call AffecterValeurs 'Mémorise la nouvelle valeur
        End If
        Application.EnableEvents = True
    End If
End If

End Sub

'Module standard
Option Base 1
Public MesValeurs() As Variant 'Le contenu de la variable persiste après l’exécution du code
Sub AffecterValeurs()
    MesValeurs = Sheets("Feuil1").UsedRange.Value
End Sub
Function LireValeurs(Lig, Col) As Variant
    If Lig > UBound(MesValeurs, 1) Or Col > UBound(MesValeurs, 2) Then 
        LireValeurs = ""
    Else
        LireValeurs = MesValeurs(Lig, Col)
    End If
End Function

Bonjour à tous,

autre façon de faire sans tout sauvegarder :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim apres
    If Target.Count > 1 Then Exit Sub
    apres = Target.Value
    Application.EnableEvents = False
    Application.Undo
    If Target <> "" Then Target.Interior.Color = vbYellow
    Target.Value = apres
    Application.EnableEvents = True
End Sub

Limité à la modif d'une cellule unique, pas sur un collé d'une plage.

J'espère que tu as conscience que le fait de lancer une macro à chaque saisie te fait perdre toute possibilité d'annulation en cas d'erreur...

L'enjeu en vaut-il la chandelle ? Je ne pense pas.

Sous prétexte de leur facilité les choses, tu leur mets de sacrés bâtons dans les roues

eric

Bonjour,

@pedro22 : la ligne : " MesValeurs = Sheets("Feuil1").UsedRange.Value " me met l'erreur 13 (j'ai bien mis les parties du code aux bons endroits)

@eriiic : ça marche très bien merci, peut-on éviter la re-sélection de la cellule quand on valide (quand on tape sur Entrée) ? Je pense que non mais je demande au cas où

Merci à vous deux

TRNX a écrit :

Bonjour,

@pedro22 : la ligne : " MesValeurs = Sheets("Feuil1").UsedRange.Value " me met l'erreur 13 (j'ai bien mis les parties du code aux bons endroits)

Sheets("Feuil1") est à adapter au nom réel de la feuille. Idem dans le reste du code. Un soucis peut se présenter si l'on inscrit une donnée hors de la plage contenant initialement des données. Auquel cas l'ajout d'une instruction du type On Error Exit Sub devrait régler le soucis ! J'ai également modifié la macro LireValeurs pour palier à ce problème.

L'empêcher, non.

Mais changer la sélection, oui :

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim apres
    If Target.Count > 1 Then Exit Sub
    apres = Target.Value
    Application.EnableEvents = False
    Application.Undo
    If Target <> "" Then Target.Interior.Color = vbYellow
    Target.Value = apres
    With Application
        If .MoveAfterReturn Then
            If .MoveAfterReturnDirection = xlToRight Then Target.Offset(, 1).Select Else Target.Offset(1).Select
        End If
    End With
    Application.EnableEvents = True
End Sub

je ne traite que les 2 principaux cas : droite et bas. Si autre choix fait dans les options il faudra compléter.

eric

@pedro22 Ok merci j'essaye ça

@eriiic en fait quand on termine de rentrer une valeur dans une cellule, parfois on clique directement dans une cellule plus loin, ça serait bien que la sélection reste sur celle-ci, si c'est clair (j'espère). Parce que là ça sélectionne la cellule d'en dessous, ce qui marche uniquement quand on fait "'Entrée" (je m'étais mal exprimé avant, j'avais pas pris en compte tous les cas, désolé)

Merci encore à vous deux

N'ayant pas trop envie de me lancer dans une usine à gaz pour une 'amélioration' qui pour moi apporte plus d'inconvénients, je préfère m'arrêter là.

eric

Bonjour,

oui je comprends tout à fait, je vais voir ce que je peux faire de mon côté.

Merci encore pour votre aide à tous les deux! (@pedro22 : j'ai réussi avec ton code !)