Как получить старое значение измененной ячейки в Excel VBA?

Вы можете использовать событие при смене ячейки, чтобы запустить макрос, который выполняет следующие действия:

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

У меня есть альтернативное решение для вас. Вы можете создать скрытый рабочий лист для сохранения старых значений для интересующего вас диапазона.

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

Я тоже должен был это сделать. Я нашел решение от "Chris R" действительно хорошим, но подумал, что он может быть более совместимым, не добавляя никаких ссылок. Крис, ты говорил об использовании коллекции. Итак, вот еще одно решение, использующее 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

Вот путь, который я использовал в прошлом. Обратите внимание, что вам нужно добавить ссылку на 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 в рабочей книге и пройти через Sheet.UsedRange, заполняющий OldVals. Кроме того, он потеряет все свои данные, если вы reset проект VBA, остановив отладчик или некоторые из них.

идея...

• записать их в модуль 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

В ответ на ответ Мэтта Роя я нашел этот вариант отличным ответом, хотя я не мог опубликовать его с моим текущим рейтингом.: (

Однако, пользуясь возможностью публиковать свои мысли о его ответе, я подумал, что воспользуюсь возможностью, чтобы включить небольшую модификацию. Просто сравните код, чтобы увидеть.

Так спасибо Мэтту Рою за то, что он привлек этот код к нашему вниманию, и 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

Сначала посмотрим, как определить и сохранить значение одной ячейки, представляющей интерес. Предположим, что 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

Затем в модуле Рабочих листов (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, которые изменяют значение Worksheets(1).Range("B1").

Поскольку мы объявили переменную StorageArray общедоступной, вы можете ссылаться на ее последнее значение в других модулях в одном проекте VBA.

Чтобы расширить нашу область действия до обнаружения и сохранения значений нескольких интересующих ячеек, вам необходимо:

• Объявить StorageArray как двухмерный массив с количеством строк, равным количеству ячеек, которые вы контролируете.
• Измените процедуру Sub SaveToStorageArray на более общий Sub SaveToStorageArray(TargetSingleCell as Range) и измените соответствующие коды.
• Измените процедуру Private Sub Worksheet_Change, чтобы обеспечить мониторинг этих нескольких ячеек.

Приложение: Дополнительную информацию о времени жизни переменных см. В разделе https://msdn.microsoft.com/en-us/library/office/gg278427.aspx

Мне нужно было зафиксировать и сравнить старые значения с новыми значениями, введенными в сложную таблицу планирования. Мне нужно общее решение, которое работало даже тогда, когда пользователь менял много строк одновременно. Решение реализовало 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 следующим образом:

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

Инициативные словари SUB вызывается из рабочего листа .open для создания коллекций.

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

Вызывается вызов "VALUE" из кода, выполняемого из обратного вызова 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

а затем я могу вычислить сравнение некоторого текущего значения с исходным значением.

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

Марк

попробуйте это, он не будет работать для первого выбора, тогда он будет работать хорошо:)

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

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

Использование 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 (включая словарь и другие более сложные методы), будет терпеть неудачу, если вы остановите (Reset) запущенный код (например, при создании новых макросов, отладке какого-то кода,...). Чтобы этого избежать, рассмотрите альтернативные методы хранения (например, скрытый рабочий лист).

Мне понадобилась эта функция, и мне не нравились все вышеприведенные решения после большинства попыток, поскольку они либо

• Медленный
• Имеют сложные последствия, например, применение application.undo.
• Не снимать, если они не были выбраны.
• Не фиксирует значения, если они не были изменены до
• Слишком сложно

Ну, я очень об этом думал, и я закончил решение для полной истории UNDO, REDO.

Чтобы записать старое значение, на самом деле это очень просто и очень быстро.

Мое решение состоит в том, чтобы захватить все значения, как только пользователь откроет лист, откроется в переменную и будет обновляться после каждого изменения. эта переменная будет использоваться для проверки старого значения ячейки. В решениях, прежде всего, они используются для цикла. На самом деле есть более простой способ.

Чтобы записать все значения, я использовал эту простую команду

SheetStore = sh.UsedRange.Formula

Да, просто это, На самом деле excel вернет массив, если диапазон - это несколько ячеек, поэтому нам не нужно использовать команду FOR EACH, и это очень быстро

Следующий подраздел - это полный код, который должен вызываться в Workbook_SheetActivate. Для сбора изменений необходимо создать другой элемент. Например, у меня есть sub под названием "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)

это фрагмент, объясняющий метод, я надеюсь, что всем это нравится

Просто мысль, но вы пробовали использовать application.undo

Это снова вернет значения. Затем вы можете просто прочитать исходное значение. Сначала не следует сохранять новые значения, поэтому вы можете изменить их обратно, если хотите.