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

Question

我正在检测像这样的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

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

Answer 1

试试这个

声明变量说

Dim oval

和SelectionChange事件

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

并在您的Worksheet_Change事件集

中

old_value = oval

Answer 2

您可以在单元格更改上使用事件来触发执行以下操作的宏：

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

Answer 3

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

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

关闭工作簿时将其删除...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

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

End Sub

并修改你的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)

Answer 4

这是我过去使用过的一种方式。请注意，您必须添加对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

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

Answer 5

我也必须这样做。我发现“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

Answer 6

一个想法......

• 在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

Answer 7

将以下内容放在工作表的代码模块中，以跟踪每个单元格在使用范围内的最后一个值：

Option Explicit

Private r As Range
Private Const d = "||"

Public Function ValueLast(r As Range)
    On Error Resume Next
    ValueLast = Split(r.ID, d)(1)
End Function

Private Sub Worksheet_Activate()
    For Each r In Me.UsedRange: Record r: Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    For Each r In Target: Record r: Next
End Sub

Private Sub Record(r)
    r.ID = r.Value & d & Split(r.ID, d)(0)
End Sub

就是这样。

此解决方案使用晦涩难懂，几乎从未使用过 Range.ID属性，该属性允许在保存和关闭工作簿时保留旧值。

任何时候您都可以得到旧的价值 一个单元格，它的确不同于新的当前值：

With Sheet1
    MsgBox .[a1].Value
    MsgBox .ValueLast(.[a1])
End With

Answer 8

我对 Matt Roy 的解决方案进行了一些扩展，顺便说一下，这很棒。我所做的是处理用户选择整行/列的情况，因此宏只记录选择和“.UsedRange”之间的交集，还处理选择不是范围的情况（对于按钮、形状、数据透视表）

Sub trackChanges_loadOldValues_toCollection(ByVal Target As Range)
    'LOADS SELECTION AND VALUES INTO THE COLLECTION collOldValues
    If isErrorHandlingOff = False Then: On Error GoTo endWithError
    
    Dim RngI As Range, newTarget As Range, arrValues, arrFormulas, arrAddress
    
    'DON'T RECORD WHEN SELECTING BUTTONS OR SHAPES, ONLY FOR RANGES
    If TypeName(Target) <> "Range" Then: Exit Sub
    
    'RESET OLD VALUES COLLECITON
    Set collOldValues = Nothing
    
    'ONLY RECORD CELLS IN USED RANGE, TO AVOID ISSUES WHEN SELECTING WHOLE ROW
    Set newTarget = Intersect(Target, Target.Parent.UsedRange)
    
    'newTarget.Select
    If Not newTarget Is Nothing Then
        For Each RngI In newTarget
            'ADD TO COLLECTION
            'ITEM, KEY
            collOldValues.add Array(RngI.value, RngI.formula), RngI.Address
        Next RngI
    End If
done:
        Exit Sub
endWithError:
        DisplayError Err, "trackChanges_loadOldValues_toCollection", Erl
End Sub

Answer 9

我遇到了与您相同的问题，幸运的是，我已从此链接中阅读了解决方案： 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

注意：必须将oldValue变量作为全局变量放置，以便所有子类都可以使用它。

Answer 10

为了回应马特罗伊的回答，我发现这个选项很有反响，虽然我不能以我当前的评分发布。 ：（

然而，在借此机会发表我对他的回应的看法时，我想我会借此机会进行一次小修改。只需比较代码即可。

感谢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

Answer 11

让我们首先看看如何检测并保存感兴趣的单个细胞的值。假设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

然后在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

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

由于我们已将变量Worksheets(1).Range("B1")声明为public，您可以在同一VBA项目的其他模块中引用其最新值。

要将我们的范围扩展到检测并保存多个感兴趣的细胞的值，您需要：

• 将StorageArray声明为二维数组，行数等于您监控的单元格数。
• 将StorageArray程序修改为更一般的Sub SaveToStorageArray并更改 相关代码。
• 修改Sub SaveToStorageArray(TargetSingleCell as Range)程序以适应对这些多个单元格的监控。

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

Answer 12

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

班级：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

我有三张纸跟踪单元格。每个工作表在名为ProjectPlan的模块中将其自己的集合作为全局变量获取，如下所示：

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

从工作表.open中调用InitDictionaries SUB来建立集合。

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

有三个模块用于管理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

繁重的工作在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

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

   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

然后我可以自由计算将某些当前值与原始值进行比较。

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

标记

Answer 13

尝试这个，它不适用于第一个选择，然后它会很好用：）

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 14

我需要这个功能，并且在尝试最多之后我不喜欢上面的所有解决方案，因为它们是

1. 慢
2. 有一些复杂的含义，比如使用application.undo。
3. 如果没有被选中，请不要捕获
4. 如果在
之前未更改值，请勿捕获值
5. 太复杂了

我对此非常认真，并且我完成了一个完整的UNDO，REDO历史的解决方案。

要捕获旧值，它实际上非常简单且非常快。

我的解决方案是在用户打开工作表打开变量后捕获所有值，并在每次更改后更新。此变量将用于检查单元格的旧值。在上面的解决方案中，所有这些都用于循环。实际上有更方便的方法。

要捕获我使用这个简单命令的所有值

SheetStore = sh.UsedRange.Formula

是的，就是这样，如果范围是多个单元格，实际上excel将返回一个数组，因此我们不需要使用FOR EACH命令而且速度非常快

以下子是应在Workbook_SheetActivate中调用的完整代码。应创建另一个子来捕获更改。就像，我有一个名为“catchChanges”的子程序在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

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

，所以很容易

示例如果我们想要单元格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)

这些是解释方法的片段，我希望每个人都喜欢它

Answer 15

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 16

使用Static可以解决您的问题（使用其他一些内容来正确初始化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

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

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

但请注意，如果停止（重置）运行代码（例如，在创建新宏，调试某些代码，......时），任何基于VBA变量的解决方案（包括字典和其他更复杂的方法）都将失败。为避免这种情况，请考虑使用替代存储方法（例如，隐藏工作表）。

Answer 17

我已经阅读了这篇旧文章，并且想提供另一种解决方案。

运行Application.Undo的问题是Woksheet_Change再次运行。恢复时，我们也会遇到同样的问题。

为避免这种情况，我使用一段代码来避免通过Worksheet_Change进行的第二步。

在开始之前，我们必须创建一个布尔型静态变量BlnAlreadyBeenHere，以告知Excel不要再次运行Worksheet_Change。

在这里您可以看到它：

    Private Sub Worksheet_Change(ByVal Target As Range)

    Static blnAlreadyBeenHere As Boolean

    'This piece avoid to execute Worksheet_Change again
    If blnAlreadyBeenHere Then
        blnAlreadyBeenHere = False
        Exit Sub
    End If

    'Now, we will store the old and new value
    Dim vOldValue As Variant
    Dim vNewValue As Variant

    'To store new value
    vNewValue = Target.Value

    'Undo to retrieve old value

    'To avoid new Worksheet_Change execution
    blnAlreadyBeenHere = True

    Application.Undo

    'To store old value
    vOldValue = Target.Value

    'To rewrite new value

    'To avoid new Worksheet_Change execution agein
    blnAlreadyBeenHere = True
    Target.Value = vNewValue

    'Done! I've two vaules stored
    Debug.Print vOldValue, vNewValue

End Sub

此方法的优点是不必运行Worksheet_SelectionChange。

如果我们希望例程从另一个模块运行，我们只需要从例程中取出变量blnAlreadyBeenHere的声明，然后使用Dim进行声明即可。

与vOldValue和vNewValue相同的操作，在模块的标题中

Dim blnAlreadyBeenHere As Boolean
Dim vOldValue As Variant
Dim vNewValue As Variant

Answer 18

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

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