如何在Excel VBA中获取已更改单元格的旧值?

I'm detecting changes in the values of certain cells in an Excel spreadsheet like this...

我在一个Excel电子表格中检测某些细胞的值变化…

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

Assuming this isn't too bad a way of coding this, how do I get the value of the cell before the change?

假设这不是一种很糟糕的编码方式，那么如何在更改之前获得单元格的值呢?

14 个解决方案

#1

try this

试试这个

declare a variable say

声明一个变量表示

Dim oval

and in the SelectionChange Event

在SelectionChange事件中。

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

and in your Worksheet_Change event set

在您的Worksheet_Change事件集中。

old_value = oval

#2

You can use an event on the cell change to fire a macro that does the following:

您可以使用单元格上的一个事件来触发一个宏，该宏执行以下操作:

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

#3

Here's a way I've used in the past. Please note that you have to add a reference to the Microsoft Scripting Runtime so you can use the Dictionary object - if you don't want to add that reference you can do this with Collections but they're slower and there's no elegant way to check .Exists (you have to trap the error).

这是我过去用过的方法。请注意,您必须添加一个引用微软脚本运行时你可以使用字典对象——如果你不想添加引用您可以收藏但他们慢和没有优雅的方式来检查.Exists(你必须陷阱错误)。

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

Like any similar method, this has its problems - first off, it won't know the "old" value until the value has actually been changed. To fix this you'd need to trap the Open event on the workbook and go through Sheet.UsedRange populating OldVals. Also, it will lose all its data if you reset the VBA project by stopping the debugger or some such.

与任何类似的方法一样，这也有它的问题——首先，它不会知道“旧”值，直到该值实际被更改。要解决这个问题，您需要在工作簿上捕获打开的事件，并检查工作表。UsedRange填充OldVals。此外，如果您通过停止调试器或类似的方法重置VBA项目，它将丢失所有的数据。

#4

I have an alternative solution for you. You could create a hidden worksheet to maintain the old values for your range of interest.

我有一个替代方案。您可以创建一个隐藏的工作表来维护您感兴趣的范围的旧值。

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

Delete it when the workbook is closed...

当工作簿关闭时删除它…

Private Sub Workbook_BeforeClose(Cancel As Boolean)

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

End Sub

And modify your Worksheet_Change event like so...

修改您的Worksheet_Change事件，比如……

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)

#5

I had to do it too. I found the solution from "Chris R" really good, but thought it could be more compatible in not adding any references. Chris, you talked about using Collection. So here is another solution using Collection. And it's not that slow, in my case. Also, with this solution, in adding the event "_SelectionChange", it's always working (no need of workbook_open).

我也得这么做。我发现“Chris R”中的解决方案非常好，但我认为不添加任何引用可以更兼容。克里斯，你说过使用收藏。这是另一个使用集合的解决方案。在我看来，这并不是那么慢。同样，有了这个解决方案，在添加事件“_SelectionChange”时，它总是在工作(不需要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

#6

an idea ...

一个想法……

• write these in the ThisWorkbook module
• 在ThisWorkbook模块中编写这些
• close and open the workbook
• 关闭并打开工作簿

    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

#7

try this, it will not work for the first selection, then it will work nice :)

试试这个，它不会在第一次选择中起作用，那么它会很好:)

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

#8

I had a need to capture and compare old values to the new values entered into a complex scheduling spreadsheet. I needed a general solution which worked even when the user changed many rows at the same time. The solution implemented a CLASS and a COLLECTION of that class.

我需要捕获并比较旧值和输入到复杂调度电子表格中的新值。我需要一个通用的解决方案，即使用户同时改变了许多行，它也能工作。解决方案实现了该类的一个类和一个集合。

The class: oldValue

类: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

There are three sheets in which i track cells. Each sheet gets its own collection as a global variable in the module named ProjectPlan as follows:

我在三张纸上跟踪细胞。每个表单都将自己的集合作为一个全局变量在名为ProjectPlan的模块中获得:

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

The InitDictionaries SUB is called out of worksheet.open to establish the collections.

initdictionary子被从工作表中调用。打开以建立集合。

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

There are three modules used to manage each collection of oldValue objects they are Add, Exists, and Value.

有三个模块用于管理它们添加、存在和值的oldValue对象集合。

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

The heavy lifting is done in the Worksheet_SelectionChange callback. One of the four is shown below. The only difference is the collection used in the ADD and EXIST calls.

重载在Worksheet_SelectionChange回调中完成。四个中的一个如下所示。惟一的区别是ADD和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

THe VALUE call is called out of code executed from the Worksheet_Change Callback for example. I need to assign the correct collection based on the sheet name:

例如，从Worksheet_Change回调执行的代码中调用值调用。我需要根据表格名称分配正确的集合:

   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

and then i am free to compute compare the some current value to the original value.

然后我可以*地计算比较当前值和原始值。

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

Mark

马克

#9

Let's first see how to detect and save the value of a single cell of interest. Suppose Worksheets(1).Range("B1") is your cell of interest. In a normal module, use this:

让我们首先看看如何检测并保存感兴趣的单个单元格的值。假设工作表(1). range(“B1”)是您感兴趣的单元格。在一个正常的模块中，使用这个:

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

Then in the module of Worksheets(1):

在工作表模块(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

This will capture the change of the Worksheets(1).Range("B1"), whether the change is due to the user actively selecting that cell on the Worksheet and changing the value, or due to other VBA codes that change the value of Worksheets(1).Range("B1").

这将捕获工作表(1). range(“B1”)的更改，无论该更改是由于用户在工作表上主动选择该单元格并更改值，还是由于其他VBA代码改变了工作表的值(1). range(“B1”)。

Since we have declared the variable StorageArray as public, you can reference its latest value in other modules in the same VBA project.

由于我们已经将变量StorageArray声明为public，所以您可以在同一个VBA项目的其他模块中引用它的最新值。

To expand our scope to the detection and saving the values of multiple cells of interest, you need to:

要将我们的范围扩大到检测和保存感兴趣的多个单元的值，您需要:

• Declare the StorageArray as a two-dimensional array, with the number of rows equal to the number of cells you are monitoring.
• 将StorageArray声明为一个二维数组，其行数等于您正在监视的单元数。
• Modify the Sub SaveToStorageArray procedure to a more general Sub SaveToStorageArray(TargetSingleCell as Range) and change the relevant codes.
• 将子SaveToStorageArray过程修改为更通用的Sub SaveToStorageArray(TargetSingleCell作为范围)并更改相关代码。
• Modify the Private Sub Worksheet_Change procedure to accommodate the monitoring of those multiple cells.
• 修改私有子Worksheet_Change过程以适应对这些多个单元的监视。

Appendix: For more information on the lifetime of variables, please refer to: https://msdn.microsoft.com/en-us/library/office/gg278427.aspx

附录:有关变量生命周期的更多信息，请参见:https://msdn.microsoft.com/en-us/library/office/gg278427.aspx

#10

In response to Matt Roy answer, I found this option a great response, although I couldn't post as such with my current rating. :(

在回应马特·罗伊的回答时，我发现这个选项是一个很好的回答，尽管我不能在我的当前评级中这样发布。:(

However, while taking the opportunity to post my thoughts on his response, I thought I would take the opportunity to include a small modification. Just compare code to see.

然而，当我抓住这个机会发表我对他的回答的看法时，我想我可以借此机会包括一个小小的修改。只是比较代码看看。

So thanks to Matt Roy for bringing this code to our attention, and Chris.R for posting original code.

感谢Matt Roy和Chris把这些代码带给我们的关注。R用于发布原始代码。

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

#11

I needed this feature and I did not like all the solutions above after trying most as they are either

我需要这个特性，在尝试了以上所有的解决方案之后，我也不喜欢它们

1. Slow
2. 慢
3. Have complex implications like using application.undo.
4. 具有复杂的含义，如使用application.undo。
5. Do not capture if they were not selected
6. 如果它们没有被选中，不要捕获
7. Do not captures values if they were not changed before
8. 如果以前没有更改值，则不捕获值
9. Too complex
10. 太复杂

Well I thought very hard about it and I completed a solution for a full UNDO,REDO history.

我想了很多，我完成了一个完全撤销的解决方案，重做历史。

To capture the old value it is actually very easy and very fast.

要获取旧值，实际上非常简单，而且非常快。

My solution is to capture all values once the user open the sheet is open into a variable and it gets updated after each change. this variable will be used to check the old value of the cell. In the solutions above all of them used for loop. Actually there is way easier method.

我的解决方案是在用户打开表时捕获所有值，并在每次更改后更新该值。这个变量将用于检查单元格的旧值。在上面的所有解中，它们都用于循环。其实有更简单的方法。

To capture all the values I used this simple command

为了捕获所有的值，我使用了这个简单的命令

SheetStore = sh.UsedRange.Formula

Yeah, just that, Actually excel will return an array if the range is a multiple cells so we do not need to use FOR EACH command and it is very fast

是的，就这样，实际上excel会返回一个数组如果范围是多个单元格那么我们不需要对每个命令都使用它，它非常快

The following sub is the full code which should be called in Workbook_SheetActivate. Another sub should be created to capture the changes. Like, I have a sub called "catchChanges" that runs on Workbook_SheetChange. It will capture the changes then save them on another a change history sheet. then runs UpdateCache to update the cache with the new values

下面的子代码是应该在Workbook_SheetActivate中调用的完整代码。应该创建另一个子以捕获更改。比如，我有一个叫做“汇兑”的子文件，它在Workbook_SheetChange上运行。它将捕获更改，然后将它们保存到另一个更改历史表中。然后运行UpdateCache，使用新的值更新缓存

' 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

now to get the old value it is very easy as the array have the same address of cells

现在要得到旧值很容易，因为数组具有相同的单元格地址

examples if we want cell D12 we can use the following

如果我们想要单元格D12，我们可以使用以下示例

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)

these are snippet explaining the method, I hope everyone like it

这些是解释方法的片段，希望大家喜欢

#12

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

#13

Using Static will solve your problem (with some other stuff to initialize old_value properly:

使用静态将解决您的问题(使用其他一些东西正确初始化old_value:

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

In workbook code, force call of Worksheet_change to fill old_value:

在工作簿代码中，强制调用Worksheet_change来填充old_value:

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

Note, however, that ANY solution based in VBA variables (including dictionary and another more sophisticate methods) will fail if you stop (Reset) running code (eg. while creating new macros, debugging some code, ...). To avoid such, consider using alternative storage methods (hidden worksheet, for example).

但是，请注意，如果停止(重置)运行的代码(例如)，那么基于VBA变量(包括dictionary和其他更复杂的方法)的任何解决方案都将失败。在创建新的宏时，调试一些代码，…)为了避免这种情况，可以考虑使用其他存储方法(例如隐藏的工作表)。

#14

Just a thought, but Have you tried using application.undo

只是一个想法，但是你试过使用application。undo。

This will set the values back again. You can then simply read the original value. It should not be too difficult to store the new values first, so you change them back again if you like.

这将重新设置值。然后您可以简单地读取原始值。首先存储新值应该不会太难，所以如果您愿意，您可以再次更改它们。