Vba excel предыдущее значение ячейки

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.

The 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

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:

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.

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.

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.

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:

   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

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

• Медленный
• Имеют сложные последствия, например, применение 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)

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

Hello,

I have a column (A) with eight different text drop down options.  I need a code that will allow me to track each time the drop down is changed to a different option. I want each change to be tracked in a different cell so that I can see how each line has progressed — e.g. from Received to Query to Invalid etc.

I have the following code which works to remember the last value of the cell from column A, but I cannot figure out how to make it work for my needs:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xCell As Range
Dim xDCell As Range
Dim xHeader As String
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = «Previous value :»
x = xDic.Keys
For I = 0 To UBound(xDic.Keys)
Set xCell = Range(xDic.Keys(I))
Set xDCell = Cells(xCell.Row, 49)
xDCell.Value = «»
xDCell.Value = xDic.Items(I)
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim I, J As Long
Dim xRgArea As Range
On Error GoTo Label1
If Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
Set xDependRg = Target.Dependents
If xDependRg Is Nothing Then GoTo Label1
If Not xDependRg Is Nothing Then
Set xDependRg = Intersect(xDependRg, Range(«A:A»))
End If
Label1:
Set xRg = Intersect(Target, Range(«A:A»))
If (Not xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = Union(xRg, xDependRg)
ElseIf (xRg Is Nothing) And (Not xDependRg Is Nothing) Then
Set xChangeRg = xDependRg
ElseIf (Not xRg Is Nothing) And (xDependRg Is Nothing) Then
Set xChangeRg = xRg
Else
Application.EnableEvents = True
Exit Sub
End If
xDic.RemoveAll
For I = 1 To xChangeRg.Areas.Count
Set xRgArea = xChangeRg.Areas(I)
For J = 1 To xRgArea.Count
xDic.Add xRgArea(J).Address, xRgArea(J).Formula
Next
Next
Set xChangeRg = Nothing
Set xRg = Nothing
Set xDependRg = Nothing
Application.EnableEvents = True
End Sub

Essentially, I want every change made in column A tracked in column AW, AX, AY and so on.  There will be no more than 10 changes to an individual cell in column A.

Thanks.