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

How do I get the old value of a changed cell in Excel VBA?

提问by Brian Hooper

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?

假设这不是太糟糕的编码方式，我如何在更改之前获取单元格的值？

回答by Binil

try this

尝试这个

declare a variable say

声明一个变量说

Dim oval

and in the SelectionChangeEvent

并在SelectionChange事件中

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

and in your Worksheet_Changeevent set

并在您的 Worksheet_Change活动集中

old_value = oval

回答by RonnieDickson

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 

回答by Nick Spreitzer

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)

回答by Matt Roy

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”的解决方案非常好，但认为不添加任何引用可能更兼容。克里斯，你谈到了使用 Collection。所以这是另一个使用 Collection 的解决方案。就我而言，它并没有那么慢。此外，使用此解决方案，在添加事件“_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

回答by Chris Rae

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).

这是我过去使用的一种方法。请注意，您必须添加对 Microsoft Scripting Runtime 的引用，以便您可以使用 Dictionary 对象 - 如果您不想添加该引用，您可以使用 Collections 执行此操作，但它们速度较慢，并且没有优雅的检查方法.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.

像任何类似的方法一样，这有其问题 - 首先，在实际更改值之前，它不会知道“旧”值。要解决此问题，您需要在工作簿上捕获 Open 事件并通过 Sheet.UsedRange 填充 OldVals。此外，如果您通过停止调试器或类似方式重置 VBA 项目，它将丢失所有数据。

回答by sarmiento

an idea ...

一个主意 ...

• write these in the ThisWorkbookmodule
• close and open the workbook

• 在ThisWorkbook模块中写这些
• 关闭和打开工作簿

    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

回答by Najar

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

回答by Radiumcola

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.

我需要捕获旧值并将其与输入到复杂调度电子表格中的新值进行比较。我需要一个通用的解决方案，即使用户同时更改多行也能正常工作。该解决方案实现了该类的 CLASS 和 COLLECTION。

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.

从 worksheet.open 中调用 InitDictionaries SUB 以建立集合。

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 对象集合，它们是 Add、Exists 和 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

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:

例如，VALUE 调用是从 Worksheet_Change Callback 执行的代码中调用的。我需要根据工作表名称分配正确的集合：

   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

标记

回答by PaulDragoonM

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:

我们先来看看如何检测和保存感兴趣的单个单元格的值。假设Worksheets(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):

然后在 Worksheets(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").

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

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

由于我们已将变量声明StorageArray为公共变量，因此您可以在同一 VBA 项目的其他模块中引用其最新值。

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

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

• Declare the StorageArrayas a two-dimensional array, with the number of rows equal to the number of cells you are monitoring.
• Modify the Sub SaveToStorageArrayprocedure to a more general Sub SaveToStorageArray(TargetSingleCell as Range)and change the relevant codes.
• Modify the Private Sub Worksheet_Changeprocedure to accommodate the monitoring of those multiple cells.

• 将 声明StorageArray为二维数组，行数等于您正在监视的单元格数。
• 将Sub SaveToStorageArray程序修改为更通用Sub SaveToStorageArray(TargetSingleCell as Range)并更改相关代码。
• 修改Private Sub 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

回答by John Douglas

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

在回应 Matt Roy 的回答时，我发现这个选项是一个很好的回应，尽管我无法用我目前的评分发布这样的帖子。:(

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