Comment puis-je obtenir de l'ancienne valeur d'un changement de cellule dans Excel VBA?

Vous pouvez utiliser un événement sur la cellule à modifier 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 

Voici un moyen que j'ai utilisé dans le passé. Veuillez noter que vous devez ajouter une référence à Microsoft Scripting Runtime de sorte que vous pouvez utiliser le Dictionnaire d'objet - si vous ne voulez pas d'ajouter que la référence que vous pouvez faire cela avec des Collections mais ils sont plus lents et il n'y a pas de manière élégante à vérifier .Existe (vous avez pour intercepter 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 connaîtra pas les "vieux" de la valeur jusqu'à ce que la valeur a été effectivement changé. Pour y remédier, vous devez intercepter l'événement Open sur le classeur et de passer par Feuille.UsedRange remplissage OldVals. Aussi, il va perdre toutes ses données si vous réinitialisez le projet VBA par arrêt du débogueur ou quelque chose du genre.

une idée ...

• écrire ces dans le ThisWorkbook module
• fermer et ouvrir le classeur

 Public LastCell Que 

Private Sub Workbook_Open() 

Ensemble LastCell = ActiveCell 

End Sub 

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) 

Jeu oa = LastCell.Commentaire 

Si Pas oa n'en Est Rien, Alors 
LastCell.Commentaire.Supprimer 
Fin De Si 

Cible.AddComment Cible.Adresse 
Cible.Commentaire.Visible = True 
Ensemble LastCell = ActiveCell 

End Sub 

J'ai eu un besoin de capturer et de comparer les valeurs anciennes et les nouvelles valeurs saisies dans un complexe de planification de feuille de calcul. J'avais besoin d'une solution générale qui a fonctionné, même lorsque l'utilisateur a changé beaucoup de lignes en même temps. La solution mise en place d'une CLASSE et d'une COLLECTION de 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 laquelle j'ai suivi les cellules. Chaque feuille a 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 InitDictionaries SOUS est appelé hors de la feuille de calcul.ouvrir 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 y a trois modules utilisés pour gérer chaque collection de oldValue objets qu'ils sont Ajouter, Existe, et la Valeur.

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 gros du travail est fait dans le Worksheet_SelectionChange de rappel. L'un des quatre est indiqué ci-dessous. La seule différence est la collection utilisée dans les opérations d'AJOUT et EXISTENT appels.

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

La VALEUR d'appel est appelée hors de code exécuté à partir de la Worksheet_Change de Rappel par exemple. J'ai besoin d'affecter la bonne collection est basée sur le 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 pour calculer comparer le courant de la valeur à 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

En réponse à Matt Roy réponse, j'ai trouvé cette option, une grande réponse, bien que je ne poste pas en tant que tel avec ma notation actuelle. 🙁

Cependant, tout en profitant de l'occasion pour poster mes pensées sur sa réponse, j'ai pensé que je voudrais profiter de l'occasion pour inclure une petite modification. Il suffit de comparer le code pour voir.

Donc merci à Matt Roy pour avoir ce code à notre attention, et Chris.R pour l'affichage de code d'origine.

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

J'avais besoin de cette fonctionnalité et je n'aime pas toutes les solutions ci-dessus après avoir essayé la plupart comme ils sont soit

1. Lent
2. Avoir des incidences complexes comme l'utilisation de l'application.défaire.
3. Ne pas capturer si elles n'ont pas été sélectionnés
4. Ne capte valeurs que si elles n'ont pas été changés avant
5. Trop complexe

Eh bien, je pense très fort à elle et j'ai obtenu une solution complète DÉFAIRE,REFAIRE l'histoire.

Pour capturer l'ancienne valeur, il est effectivement très facile et très rapide.

Ma solution est de capturer toutes les valeurs une fois à l'utilisateur d'ouvrir la feuille est ouvert dans une variable, et 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 les utilisé pour la boucle. En fait, il est plus facile méthode.

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

SheetStore = sh.UsedRange.Formula

Ouais, c'est juste que, en Fait excel va retourner un tableau si la plage est l'un de plusieurs cellules, donc nous n'avons pas besoin d'utiliser POUR CHAQUE commande et il est très rapide

Le compartiment suivant est le code complet qui doit être appelée dans Workbook_SheetActivate. Un autre sous doit être créée pour enregistrer les modifications. Comme, j'ai un sub appelé "catchChanges" qui s'exécute sur Workbook_SheetChange. Il s'agira de saisir les modifications, puis de les enregistrer sur un autre un changement de l'histoire de la feuille. puis exécute UpdateCache de 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 que dans le tableau ont la même adresse de cellules

exemples si nous voulons cellule D12, nous pouvons utiliser la suite

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 extrait de en expliquant la méthode, j'espère que tout le monde comme il

À l'aide de Static permettra de résoudre votre problème (avec quelques autres trucs 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 classeur de code, la force de l'appel de Worksheet_change pour remplir old_value:

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

Noter, cependant, que TOUTE solution fondée en VBA variables (y compris les dictionnaire et un autre plus sophistiqué méthodes) échouera si vous vous arrêtez (Reset) de l'exécution de code (par exemple. lors de la création de nouvelles macros, le débogage de code, ...). Pour éviter de telles, envisager l'utilisation d'autres méthodes de stockage (caché de la feuille de calcul, par exemple).

Juste une pensée, mais Avez-vous essayé d'utiliser l'application.annuler

Ceci permettra de définir les valeurs de retour. Vous pouvez ensuite il suffit de lire la valeur d'origine. Il ne devrait pas être trop difficile à stocker les nouvelles valeurs de la première, de sorte que vous revenir à nouveau si vous le souhaitez.