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

我正在检测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

尝试这个

声明一个variables说

 Dim oval 

和SelectionChange事件中

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

并在您的Worksheet_Change事件集

 old_value = oval 

Answer 2

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

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

Answer 3

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

 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 

工作簿closures时删除它…

 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执行此操作，但速度较慢，并且没有优雅的方法来检查。存在（你必须捕捉错误）。

 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。 而且，如果你通过停止debugging器或者其他的方法来重置VBA项目，它将会丢失所有的数据。

Answer 5

我也必须这样做。 我发现“Chris R”的解决scheme确实不错，但是认为它可以在不添加任何引用的情况下更加兼容。 克里斯，你谈到使用收集。 所以这里是另一个使用Collection的解决scheme 就我而言，这并不慢。 另外，通过这个解决scheme，在添加事件“_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模块中
• closures并打开工作簿

    公共LastCell作为范围

     Private Sub Workbook_Open（）

        设置LastCell = ActiveCell

    结束小组

     Private Sub Workbook_SheetSelectionChange（ByVal Sh As Object，ByVal Target As Range）

        设置oa = LastCell.Comment

        如果不是没有什么那么
         LastCell.Comment.Delete
        万一

         Target.AddComment Target.Address
         Target.Comment.Visible = True
        设置LastCell = ActiveCell

    结束小组

Answer 7

试试这个，它不会工作的第一个select，那么它会工作很好:)

 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 8

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

类：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的模块中的全局variables，如下所示：

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

InitDictionaries SUB被叫做worksheet.open以build立集合。

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

有三个模块用于pipe理每个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_SelectionChangecallback中完成的。 下面显示了四个之一。 唯一的区别是在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 

例如，VALUE调用是从Worksheet_Changecallback中执行的代码之外调用的。 我需要根据表格名称分配正确的集合：

  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 9

我们先来看看如何检测和保存单个感兴趣单元的值。 假设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")的更改，该更改是由于用户主动select工作表上的该单元格并更改该值，还是由于其他VBA代码Worksheets(1).Range("B1") 。

由于我们已经声明variablesStorageArray为public，因此可以在同一VBA项目的其他模块中引用其最新值。

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

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

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

Answer 10

为了回应马特罗伊的回答，我发现这个选项是一个很好的回应，虽然我不能张贴我目前的评级。 🙁

但是，我借此机会张贴了自己的回应，我想我会借此机会join一点小小的修改。 只需比较代码即可看到。

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

我需要这个function，而且我也不喜欢上面所有的解决scheme

1. 慢
2. 有像使用application.undo复杂的含义。
3. 不要捕捉，如果他们没有被选中
4. 如果之前没有更改，则不要捕获值
5. 太复杂了

好吧，我认真思考，并完成了一个完整的UNDO，REDO历史的解决scheme。

为了捕捉旧的价值，它实际上是非常简单和快速的。

我的解决scheme是捕获所有值，一旦用户打开工作表打开到一个variables，并在每次更改后得到更新。 这个variables将被用来检查单元格的旧值。 在上面所有的解决scheme用于循环的解决scheme。 其实有办法更简单的方法。

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

 SheetStore = sh.UsedRange.Formula 

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

以下是在Workbook_SheetActivate中应该调用的完整代码。 应该创build另一个子来捕获更改。 就像，我有一个名为“catchChanges”，在Workbook_SheetChange上运行。 它将捕获更改，然后将其保存在另一个更改历史logging表单上。 然后运行UpdateCache以使用新值更新caching

 ' 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 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 

Answer 13

使用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 

但是，请注意，如果您停止（重置）运行代码（例如，在创build新macros，debugging某些代码时…），任何基于VBAvariables的解决scheme（包括字典和其他更复杂的方法）都将失败。 为了避免这种情况，请考虑使用替代的存储方法（例如隐藏的工作表）。

Answer 14

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

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