Comment obtenir l'ancienne valeur d'une cellule modifiée dans Excel VBA?

Question

Je détecte des changements dans les valeurs de certaines cellules dans une feuille de calcul Excel comme celle-ci ...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim old_value As String
Dim new_value As String

For Each cell In Target

    If Not (Intersect(cell, Range("cell_of_interest")) Is Nothing) Then
        new_value = cell.Value
        old_value = ' what here?
        Call DoFoo (old_value, new_value)
    End If

Next cell

End Sub

En supposant que ce ne soit pas une très mauvaise façon de coder cela, comment puis-je obtenir la valeur de la cellule avant le changement?

Answer 1

essaye ça

déclarer une variable dit

Dim oval

et dans l'événement SelectionChange

Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oval = Target.Value
End Sub

et dans votre ensemble d'événements Worksheet_Change

old_value = oval

Answer 2

Vous pouvez utiliser un événement sur le changement de cellule pour déclencher une macro qui effectue les opérations suivantes:

vNew = Range("cellChanged").value
Application.EnableEvents = False
Application.Undo
vOld = Range("cellChanged").value
Range("cellChanged").value = vNew
Application.EnableEvents = True 

Answer 3

J'ai une solution alternative pour vous. Vous pouvez créer une feuille de calcul masquée pour conserver les anciennes valeurs de votre domaine d’intérêt. 

Private Sub Workbook_Open()

Dim hiddenSheet As Worksheet

Set hiddenSheet = Me.Worksheets.Add
hiddenSheet.Visible = xlSheetVeryHidden
hiddenSheet.Name = "HiddenSheet"

'Change Sheet1 to whatever sheet you're working with
Sheet1.UsedRange.Copy ThisWorkbook.Worksheets("HiddenSheet").Range(Sheet1.UsedRange.Address)

End Sub

Supprimez-le lorsque le classeur est fermé ...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.DisplayAlerts = False
Me.Worksheets("HiddenSheet").Delete
Application.DisplayAlerts = True

End Sub

Et modifiez votre événement Worksheet_Change comme suit ...

For Each cell In Target

    If Not (Intersect(cell, Range("cell_of_interest")) Is Nothing) Then
        new_value = cell.Value
        ' here's your "old" value...
        old_value = ThisWorkbook.Worksheets("HiddenSheet").Range(cell.Address).Value
        Call DoFoo(old_value, new_value)
    End If

Next cell

' Update your "old" values...
ThisWorkbook.Worksheets("HiddenSheet").UsedRange.Clear
Me.UsedRange.Copy ThisWorkbook.Worksheets("HiddenSheet").Range(Me.UsedRange.Address)

Answer 4

Voici une façon que j'ai utilisée dans le passé. Notez que vous devez ajouter une référence à Microsoft Scripting Runtime pour pouvoir utiliser l'objet Dictionary. Si vous ne souhaitez pas ajouter cette référence, vous pouvez le faire avec Collections, mais elles sont plus lentes et il n'y a pas de moyen élégant de vérifier. .Existe (vous devez piéger l'erreur).

Dim OldVals As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
    For Each cell In Target
        If OldVals.Exists(cell.Address) Then
            Debug.Print "New value of " & cell.Address & " is " & cell.Value & "; old value was " & OldVals(cell.Address)
        Else
            Debug.Print "No old value for " + cell.Address
        End If
        OldVals(cell.Address) = cell.Value
    Next
End Sub

Comme toute méthode similaire, cela a ses problèmes - tout d'abord, il ne saura pas "l'ancienne" valeur jusqu'à ce que la valeur ait été réellement modifiée. Pour résoudre ce problème, vous devez intercepter l'événement Open dans le classeur et parcourir Sheet.UsedRange en remplissant OldVals. En outre, il perdra toutes ses données si vous réinitialisez le projet VBA en arrêtant le débogueur ou autre.

Answer 5

Je devais le faire aussi. J'ai trouvé la solution de "Chris R" vraiment bonne, mais j'ai pensé qu'elle pourrait être plus compatible en ne ajoutant aucune référence. Chris, vous avez parlé d'utiliser Collection. Voici donc une autre solution utilisant Collection. Et ce n'est pas si lent, dans mon cas. De plus, avec cette solution, en ajoutant l'événement "_SelectionChange", cela fonctionne toujours (pas besoin de workbook_open).

Dim OldValues As New Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    'Copy old values
    Set OldValues = Nothing
    Dim c As Range
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    On Local Error Resume Next  ' To avoid error if the old value of the cell address you're looking for has not been copied
    Dim c As Range
    For Each c In Target
        Debug.Print "New value of " & c.Address & " is " & c.Value & "; old value was " & OldValues(c.Address)
    Next c
    'Copy old values (in case you made any changes in previous lines of code)
    Set OldValues = Nothing
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c
End Sub

Answer 6

une idée ...

• écrivez-les dans le module ThisWorkbook
• fermer et ouvrir le classeur

 Public LastCell As Range 

 Private Sub Workbook_Open () 

 Définissez LastCell = ActiveCell 

 End Sub 

 Private Sub Workbook_SheetSelectionChange (ByVal Sh en tant qu'objet, ByVal en tant que plage) 

 Définissez oa = LastCell.Comment 

 Si ce n'est pas rien, alors 
 LastCell.Comment.Delete 
 Fin si

 Target.AddComment Target.Address 
 Target.Comment.Visible = True 
 Définissez LastCell = ActiveCell 

 End Sub 

Answer 7

J'avais besoin de capturer et de comparer les anciennes valeurs aux nouvelles valeurs entrées dans un tableur de planification complexe. J'avais besoin d'une solution générale qui fonctionnait même lorsque l'utilisateur modifiait plusieurs lignes en même temps. La solution implémentait une CLASSE et une COLLECTION de cette classe.

La classe: oldValue

Private pVal As Variant
Private pAdr As String
Public Property Get Adr() As String
   Adr = pAdr
End Property
Public Property Let Adr(Value As String)
    pAdr = Value
End Property
Public Property Get Val() As Variant
   Val = pVal
End Property
Public Property Let Val(Value As Variant)
   pVal = Value
End Property

Il y a trois feuilles dans lesquelles je trace les cellules. Chaque feuille reçoit sa propre collection en tant que variable globale dans le module nommé ProjectPlan, comme suit:

Public prepColl As Collection
Public preColl As Collection
Public postColl As Collection
Public migrColl As Collection

La sous-unité InitDictionaries est appelée dans worksheet.open pour établir les collections.

Sub InitDictionaries()
    Set prepColl = New Collection
    Set preColl = New Collection
    Set postColl = New Collection
    Set migrColl = New Collection
End Sub

Il existe trois modules utilisés pour gérer chaque collection d'objets oldValue qu'ils sont Add, Exists et Value.

Public Sub Add(ByRef rColl As Collection, ByVal sAdr As String, ByVal sVal As Variant)
    Dim oval As oldValue
    Set oval = New oldValue
    oval.Adr = sAdr
    oval.Val = sVal
    rColl.Add oval, sAdr
End Sub

Public Function Exists(ByRef rColl As Collection, ByVal sAdr As String) As Boolean
   Dim oReq As oldValue
   On Error Resume Next
   Set oReq = rColl(sAdr)
   On Error GoTo 0

   If oReq Is Nothing Then
      Exists = False
   Else
      Exists = True
   End If
End Function
Public Function Value(ByRef rColl As Collection, ByVal sAdr) As Variant
   Dim oReq As oldValue
   If Exists(rColl, sAdr) Then
      Set oReq = rColl(sAdr)
      Value = oReq.Val
   Else
      Value = ""
   End If
End Function

Le levage de charges lourdes est effectué dans le rappel de Worksheet_SelectionChange. L'un des quatre est présenté ci-dessous. La seule différence est la collection utilisée dans les appels ADD et EXIST.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim mode As Range
   Set mode = Worksheets("schedule").Range("PlanExecFlag")
   If mode.Value = 2 Then
      Dim c As Range
      For Each c In Target
          If Not ProjectPlan.Exists(prepColl, c.Address) Then
             Call ProjectPlan.Add(prepColl, c.Address, c.Value)
          End If
      Next c
   End If
End Sub

L’appel VALUE est appelé en dehors du code exécuté à partir du rappel de feuille de calcul-Change, par exemple. Je dois attribuer la collection correcte en fonction du nom de la feuille:

   Dim rColl As Collection
   If sheetName = "Preparations" Then
       Set rColl = prepColl
   ElseIf sheetName = "Pre-Tasks" Then
       Set rColl = preColl
   ElseIf sheetName = "Migr-Tasks" Then
       Set rColl = migrColl
   ElseIf sheetName = "post-Tasks" Then
       Set rColl = postColl
   Else
   End If

et puis je suis libre de calculer comparer la valeur actuelle à la valeur d'origine.

If Exists(rColl, Cell.Offset(0, 0).Address) Then
   tsk_delay = Cell.Offset(0, 0).Value - Value(rColl, Cell.Offset(0, 0).Address)
Else
   tsk_delay = 0
End If

Marque

Answer 8

Voyons d'abord comment détecter et sauvegarder la valeur d'une seule cellule d'intérêt. Supposons que Worksheets(1).Range("B1") soit votre cellule d’intérêt. Dans un module normal, utilisez ceci:

Option Explicit

Public StorageArray(0 to 1) As Variant 
    ' Declare a module-level variable, which will not lose its scope as 
      ' long as the codes are running, thus performing as a storage place.
    ' This is a one-dimensional array. 
      ' The first element stores the "old value", and 
      ' the second element stores the "new value"

Sub SaveToStorageArray()
' ACTION
    StorageArray(0) = StorageArray(1)
        ' Transfer the previous new value to the "old value"

    StorageArray(1) = Worksheets(1).Range("B1").value 
        ' Store the latest new value in Range("B1") to the "new value"

' OUTPUT DEMONSTRATION (Optional)
    ' Results are presented in the Immediate Window.
    Debug.Print "Old value:" & vbTab & StorageArray(0)
    Debug.Print "New value:" & vbTab & StorageArray(1) & vbCrLf

End Sub

Puis dans le module de feuilles de calcul (1):

Option Explicit

Private HasBeenActivatedBefore as Boolean
    ' Boolean variables have the default value of False.
    ' This is a module-level variable, which will not lose its scope as 
      ' long as the codes are running.

Private Sub Worksheet_Activate()        
    If HasBeenActivatedBefore = False then
        ' If the Worksheet has not been activated before, initialize the
          ' StorageArray as follows.

        StorageArray(1) = Me.Range("B1")
            ' When the Worksheets(1) is activated, store the current value
              ' of Range("B1") to the "new value", before the 
              ' Worksheet_Change event occurs.

        HasBeenActivatedBefore = True
            ' Set this parameter to True, so that the contents
              ' of this if block won't be evaluated again. Therefore, 
              ' the initialization process above will only be executed 
              ' once.
    End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("B1")) Is Nothing then
        Call SaveToStorageArray
            ' Only perform the transfer of old and new values when 
              ' the cell of interest is being changed.
    End If
End Sub

Cela capturera le changement de Worksheets(1).Range("B1"), que le changement soit dû à la sélection active de cette cellule dans la feuille de calcul et à la modification de la valeur, ou à d'autres codes VBA modifiant la valeur de Worksheets(1).Range("B1").

Comme nous avons déclaré la variable StorageArray publique, vous pouvez référencer sa dernière valeur dans d'autres modules du même projet VBA.

Pour étendre notre champ à la détection et la sauvegarde des valeurs de plusieurs cellules d’intérêt, vous devez:

• Déclarez la StorageArray sous la forme d'un tableau à deux dimensions, avec un nombre de lignes égal au nombre de cellules que vous surveillez.
• Modifiez la procédure Sub SaveToStorageArray en une Sub SaveToStorageArray(TargetSingleCell as Range) plus générale et modifiez les codes pertinents
• Modifiez la procédure Private Sub Worksheet_Change pour permettre la surveillance de ces cellules multiples.

Annexe: Pour plus d’informations sur la durée de vie des variables, veuillez consulter: https://msdn.Microsoft.com/en-us/library/office/gg278427.aspx

Answer 9

J'ai le même problème que vous et heureusement j'ai lu la solution depuis ce lien: http://access-Excel.tips/value-before-worksheet-change/

Dim oldValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    oldValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    'do something with oldValue...
End Sub

Remarque: vous devez placer la variable oldValue en tant que variable globale pour que toutes les sous-classes puissent l'utiliser.

Answer 10

En réponse à la réponse de Matt Roy, j'ai trouvé cette option très intéressante, bien que je ne puisse pas publier en tant que telle avec ma note actuelle. :(

Cependant, tout en profitant de cette occasion pour poster mes réflexions sur sa réponse, je pensais profiter de cette occasion pour inclure une petite modification. Il suffit de comparer le code pour voir.

Merci donc à Matt Roy d’avoir porté ce code à notre attention et à Chris.R d’avoir publié le code original.

Dim OldValues As New Collection

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'>> Prevent user from multiple selection before any changes:

 If Selection.Cells.Count > 1 Then
        MsgBox "Sorry, multiple selections are not allowed.", vbCritical
        ActiveCell.Select
        Exit Sub
    End If
 'Copy old values
    Set OldValues = Nothing
    Dim c As Range
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next

 On Local Error Resume Next  ' To avoid error if the old value of the cell address you're looking for has not been copied

Dim c As Range

    For Each c In Target
        If OldValues(c.Address) <> "" And c.Value <> "" Then 'both Oldvalue and NewValue are Not Empty
                    Debug.Print "New value of " & c.Address & " is " & c.Value & "; old value was " & OldValues(c.Address)
        ElseIf OldValues(c.Address) = "" And c.Value = "" Then 'both Oldvalue and NewValue are  Empty
                    Debug.Print "New value of " & c.Address & " is Empty " & c.Value & "; old value is Empty" & OldValues(c.Address)

        ElseIf OldValues(c.Address) <> "" And c.Value = "" Then 'Oldvalue is Empty and NewValue is Not Empty
                    Debug.Print "New value of " & c.Address & " is Empty" & c.Value & "; old value was " & OldValues(c.Address)
        ElseIf OldValues(c.Address) = "" And c.Value <> "" Then 'Oldvalue is Not Empty and NewValue is Empty
                    Debug.Print "New value of " & c.Address & " is " & c.Value & "; old value is Empty" & OldValues(c.Address)
        End If
    Next c

    'Copy old values (in case you made any changes in previous lines of code)
    Set OldValues = Nothing
    For Each c In Target
        OldValues.Add c.Value, c.Address
    Next c

Answer 11

essayez ceci, ça ne marchera pas pour la première sélection, alors ça marchera bien :)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo 10
    If Target.Count > 1 Then GoTo 10
    Target.Value = lastcel(Target.Value)
    10
End Sub


Function lastcel(lC_vAl As String) As String
    Static vlu
    lastcel = vlu
    vlu = lC_vAl
End Function

Answer 12

J'avais besoin de cette fonctionnalité et je n'ai pas aimé toutes les solutions ci-dessus après avoir essayé le plus, car elles sont soit

1. Lent 
2. Avoir des implications complexes comme utiliser application.undo. 
3. Ne pas capturer s'ils n'ont pas été sélectionnés
4. Ne saisit pas les valeurs si elles n'avaient pas été modifiées auparavant
5. Trop compliqué

Eh bien, j'y ai beaucoup réfléchi et j'ai mis au point une solution pour une histoire complète de UNDO, REDO.

Pour saisir l’ancienne valeur, c’est très facile et très rapide.

Ma solution est de capturer toutes les valeurs une fois que l'utilisateur ouvre la feuille est ouverte dans une variable et qu'il est mis à jour après chaque modification. cette variable sera utilisée pour vérifier l'ancienne valeur de la cellule. Dans les solutions ci-dessus tous utilisés pour la boucle. En fait, il existe une méthode beaucoup plus simple.

Pour capturer toutes les valeurs, j'ai utilisé cette commande simple

SheetStore = sh.UsedRange.Formula

Oui, Justement, Excel renverra un tableau si la plage est constituée de plusieurs cellules, de sorte que nous n’avons pas besoin d’utiliser la commande FOR EACH et qu’elle est très rapide

Le sous-code suivant est le code complet qui doit être appelé dans Workbook_SheetActivate. Un autre sous devrait être créé pour capturer les changements. Comme, j'ai un sous appelé "catchChanges" qui s'exécute sur Workbook_SheetChange. Il capturera les modifications puis les enregistrera sur une autre feuille d’historique des modifications. exécute ensuite UpdateCache pour mettre à jour le cache avec les nouvelles valeurs

' should be added at the top of the module
Private SheetStore() As Variant 
Private SheetStoreName As String  ' I use this variable to make sure that the changes I captures are in the same active sheet to prevent overwrite

Sub UpdateCache(sh As Object)
      If sh.Name = ActiveSheet.Name Then ' update values only if the changed values are in the activesheet
          SheetStoreName = sh.Name
          ReDim SheetStore(1 To sh.UsedRange.Rows.count, 1 To sh.UsedRange.Columns.count) ' update the dimension of the array to match used range
          SheetStore = sh.UsedRange.Formula
      End If
End Sub

maintenant, pour obtenir l'ancienne valeur, il est très facile car le tableau a la même adresse de cellules

exemples si nous voulons la cellule D12, nous pouvons utiliser ce qui suit 

SheetStore(row_number,column_number)
'example
return = SheetStore(12,4)
' or the following showing how I used it. 
set cell = activecell ' the cell that we want to find the old value for
newValue = cell.value ' you can ignore this line, it is just a demonstration
oldValue = SheetStore(cell.Row, cell.Column)

ce sont des extraits expliquant la méthode, j'espère que tout le monde l'aime

Answer 13

Private Sub Worksheet_Change(ByVal Target As Range)
vNEW = Target.Value
aNEW = Target.Address
Application.EnableEvents = False
Application.Undo
vOLD = Target.Value
Target.Value = vNEW
Application.EnableEvents = True
End Sub

Answer 14

Utiliser Static résoudra votre problème (avec quelques autres choses pour initialiser old_value correctement:

Private Sub Worksheet_Change(ByVal Target As Range)
    Static old_value As String
    Dim inited as Boolean 'Used to detect first call and fill old_value
    Dim new_value As String
    If Not Intersect(cell, Range("cell_of_interest")) Is Nothing Then
         new_value = Range("cell_of_interest").Value
         If Not inited Then
             inited = True
         Else
            Call DoFoo (old_value, new_value)
        End If
        old_value = new_value
    Next cell
End Sub

Dans le code du classeur, forcez l'appel de Worksheet_change à remplir old_value:

Private Sub Private Sub Workbook_Open()
     SheetX.Worksheet_Change SheetX.Range("cell_of_interest")
End Sub

Notez cependant que TOUTES LES solutions basées sur des variables VBA (y compris un dictionnaire et d’autres méthodes plus sophistiquées) échoueront si vous arrêtez le code en cours d’exécution (par exemple, lors de la création de nouvelles macros, du débogage de code, ...). Pour éviter cela, envisagez d'utiliser d'autres méthodes de stockage (feuille de calcul masquée, par exemple).