Comment puis-je obtenir l'ancienne valeur d'une cellule changée dans Excel VBA?
je détecte des changements dans les valeurs de certaines cellules dans un tableur Excel comme celui-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 n'est pas une trop mauvaise façon de coder ceci, Comment puis-je obtenir la valeur de la cellule avant le changement?
14 réponses
essayez ceci
déclarer une variable dire
Dim oval
et SelectionChange
Événement
Public Sub Worksheet_SelectionChange(ByVal Target As Range)
oval = Target.Value
End Sub
et Worksheet_Change
événement
old_value = oval
Vous pouvez utiliser un événement sur la modification de la cellule pour lancer une macro qui fait ce qui suit:
vNew = Range("cellChanged").value
Application.EnableEvents = False
Application.Undo
vOld = Range("cellChanged").value
Range("cellChanged").value = vNew
Application.EnableEvents = True
j'ai une solution alternative pour vous. Vous pouvez créer une feuille de travail cachée pour maintenir les anciennes valeurs pour votre gamme 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
Supprimer 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 L'événement Worksheet_Change comme ceci...
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)
Voici un moyen que j'ai utilisé dans le passé. S'il vous plaît noter que vous devez ajouter une référence à L'exécution de Scripting de Microsoft de sorte que vous pouvez utiliser l'objet de dictionnaire - si vous ne voulez pas ajouter cette référence, vous pouvez le faire avec des Collections, mais ils sont plus lents et il n'y a pas de façon élégante de 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 n'importe quelle méthode similaire, cela a ses problèmes - d'abord, il ne connaîtra pas la "vieille" valeur jusqu'à ce que la valeur ait réellement été changée. Fixer cela, vous devez piéger l'événement ouvert sur le cahier de travail et passer en revue la feuille.UsedRange remplissage OldVals. De plus, il perdra toutes ses données si vous réinitialisez le projet VBA en arrêtant le débogueur ou un autre.
j'ai eu à le faire aussi. J'ai trouvé la solution de "Chris R" très bonne, mais j'ai pensé qu'il pourrait être plus compatible en n'ajoutant aucune référence. Chris, tu as parlé D'utiliser la Collection. Voici donc une autre solution utilisant la collecte. Et il n'est pas 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
une idée ...
- écrivez ceci dans le
ThisWorkbook
module - fermez et ouvrez le classeur
Public LastCell As Range Private Sub Workbook_Open() Set LastCell = ActiveCell End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Set oa = LastCell.Comment If Not oa Is Nothing Then LastCell.Comment.Delete End If Target.AddComment Target.Address Target.Comment.Visible = True Set LastCell = ActiveCell End Sub
essayez cela, il ne fonctionne pas pour la première sélection, ensuite, il sera sympa :)
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
j'avais besoin de saisir 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 changeait beaucoup de lignes en même temps. La solution implémente 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 comme une variable globale dans le module appelé ProjectPlan as suit:
Public prepColl As Collection
Public preColl As Collection
Public postColl As Collection
Public migrColl As Collection
le sous-titre InitDictionaries est appelé hors de la feuille de travail.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 d'objets de valeur ancienne 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 lourd est fait dans le Worksheet_SelectionChange callback. L'un des quatre est indiqué ci-dessous. La seule différence est la collecte 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
la valeur l'appel est appelé hors du code exécuté à partir de la fonction de rappel de Worksheet_Change 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 de comparer la valeur actuelle à la valeur originale.
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
nous allons d'abord voir comment détecter et enregistrer la valeur d'une seule cellule d'intérêt. Supposons que Worksheets(1).Range("B1")
est votre cellule d'intérêt. Dans un module, 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 des feuilles de travail (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û au fait que l'utilisateur sélectionne activement cette case sur la feuille de travail et change la valeur, ou à d'autres codes VBA qui changent la valeur de Worksheets(1).Range("B1")
.
Depuis nous avons déclaré la variable StorageArray
en tant que public, vous pouvez référencer sa dernière valeur dans d'autres modules du même projet VBA.
pour étendre notre portée à la détection et à la sauvegarde des valeurs de plusieurs cellules d'intérêt, vous devez:
- déclarez le
StorageArray
comme un tableau bidimensionnel, avec le nombre de lignes égal au nombre de cellules que vous surveillez. - Modifier
Sub SaveToStorageArray
procédure à un plus généralSub SaveToStorageArray(TargetSingleCell as Range)
et de changer le pertinent code. - Modifier
Private Sub Worksheet_Change
procédure pour permettre la surveillance de ces cellules multiples.
Annexe: Pour de plus amples renseignements sur la durée de vie des variables, veuillez consulter: https://msdn.microsoft.com/en-us/library/office/gg278427.aspx
en réponse à la réponse de Matt Roy, j'ai trouvé cette option une excellente réponse, bien que je ne pouvais pas poster en tant que tel avec ma note actuelle. : (
cependant, tout en profitant de l'occasion pour poster mes réflexions sur sa réponse, j'ai pensé que je profiterais de l'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 pour afficher 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
j'avais besoin de cette fonctionnalité et je n'ai pas aimé toutes les solutions ci-dessus après avoir essayé la plupart car ils sont soit
- Lent
- ont des implications complexes comme l'utilisation de l'application.annuler.
- ne pas capturer s'ils n'ont pas été sélectionnés
- ne saisit pas les valeurs si elles n'ont pas été modifiées avant
- Trop complexe
Eh bien j'y ai beaucoup réfléchi et j'ai trouvé une solution pour une annulation complète, REDO 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 que l'utilisateur ouvre la feuille est ouverte dans une variable et elle est mise à jour après chaque changement. cette variable sera utilisée pour vérifier l'ancienne valeur de la cellule. Dans les solutions surtout d'eux utilisés pour la boucle. En fait, il ya méthode beaucoup plus facile.
Pour capturer toutes les valeurs que j'ai utilisé cette commande simple
SheetStore = sh.UsedRange.Formula
Oui, juste cela, en fait excel retournera un tableau si la gamme est un multiple de cellules donc nous n'avons pas besoin d'utiliser pour chaque commande et il est très rapide
le sous-code suivant est le code complet qui doit être appelé dans Workbook_SheetActivate. Un autre sous-programme devrait être créé pour saisir les changements. Comme, j'ai un sous appelé "catchChanges" qui tourne sur Workbook_SheetChange. Il capturera les changements puis les enregistrera sur une autre feuille d'historique de changement. puis exécute UpdateCache pour mettre à jour le cache avec de 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 la cellule D12, nous pouvons utiliser
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 bribes expliquant la méthode, j'espère que tout le monde aime ça
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
en utilisant Static
résoudra votre problème (avec d'autres choses à 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
en code de cahier, appel de force de Worksheet_change
pour remplir old_value
:
Private Sub Private Sub Workbook_Open()
SheetX.Worksheet_Change SheetX.Range("cell_of_interest")
End Sub
notez, cependant, que toute solution basée sur des variables VBA (y compris le dictionnaire et d'autres méthodes plus sophistiquées) échouera si vous arrêtez (Réinitialisez) d'exécuter le code (par ex. tout en créant de nouvelles macros, déboguage du code, ...). Pour éviter cela, envisagez d'utiliser d'autres méthodes de stockage. (feuille de travail cachée, par exemple).
Juste une pensée, mais Avez-vous essayé d'utiliser l'application.annuler
cela va remettre les valeurs en place. Vous pouvez alors simplement lire la valeur originale. Il ne devrait pas être trop difficile de stocker les nouvelles valeurs en premier, donc vous les changez de nouveau si vous le souhaitez.