如何在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