excel - variable - tomar el valor de una celda macros

¿Cómo obtengo el valor anterior de una celda modificada en Excel VBA?

Question

Estoy detectando cambios en los valores de ciertas celdas en una hoja de cálculo de Excel como esta ...

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

Suponiendo que esto no sea una mala manera de codificar esto, ¿cómo obtengo el valor de la celda antes del cambio?

Answer 1

En respuesta a la respuesta de Matt Roy, encontré esta opción como una gran respuesta, aunque no pude publicar como tal con mi calificación actual. :(

Sin embargo, mientras aprovechaba la oportunidad para publicar mis pensamientos sobre su respuesta, pensé que podría aprovechar la oportunidad para incluir una pequeña modificación. Simplemente compare el código para ver.

Así que gracias a Matt Roy por traer este código a nuestra atención, y a Chris.R por publicar el código original.

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 2

Esta es una forma que he usado en el pasado. Tenga en cuenta que debe agregar una referencia al Microsoft Scripting Runtime para que pueda usar el objeto Dictionary; si no desea agregar esa referencia, puede hacerlo con Collections, pero son más lentos y no hay una forma elegante de verificarlo .Exists (tienes que atrapar el error).

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

Al igual que cualquier método similar, esto tiene sus problemas: en primer lugar, no conocerá el valor "anterior" hasta que el valor haya sido realmente cambiado. Para arreglar esto, necesitaría atrapar el evento Open en el libro de trabajo y pasar por Sheet.UsedRange poblando OldVals. Además, perderá todos sus datos si restablece el proyecto de VBA al detener el depurador o algo así.

Answer 3

Necesitaba esta característica y no me gustaron todas las soluciones anteriores después de probar la mayoría ya que son

1. Lento
2. Tener implicaciones complejas como usar application.undo.
3. No capturar si no fueron seleccionados
4. No captura valores si no se cambiaron antes
5. Demasiado complejo

Bueno, pensé mucho sobre ello y completé una solución para una historia completa de UNDO, REDO.

Para capturar el valor anterior, en realidad es muy fácil y muy rápido.

Mi solución es capturar todos los valores una vez que el usuario abra la hoja se abre en una variable y se actualiza después de cada cambio. esta variable se usará para verificar el valor anterior de la celda. En las soluciones anteriores, todas ellas se usan para bucle. En realidad, hay un método mucho más fácil.

Para capturar todos los valores, utilicé este comando simple

SheetStore = sh.UsedRange.Formula

Sí, solo eso, En realidad, Excel devolverá una matriz si el rango es un número de celdas múltiples, por lo que no es necesario que utilice PARA CADA orden y es muy rápido.

El siguiente sub es el código completo que debe invocarse en Workbook_SheetActivate. Se debe crear otro sub para capturar los cambios. Me gusta, tengo un sub llamado "catchChanges" que se ejecuta en Workbook_SheetChange. Capturará los cambios y luego los guardará en otra hoja de historial de cambios. luego ejecuta UpdateCache para actualizar el caché con los nuevos valores

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

ahora para obtener el valor anterior es muy fácil ya que la matriz tiene la misma dirección de celdas

ejemplos si queremos la celda D12 podemos usar la siguiente

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)

estos son fragmentos que explican el método, espero que a todos les guste

Answer 4

Puede usar un evento en el cambio de celda para activar una macro que haga lo siguiente:

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

Answer 5

Solo un pensamiento, pero ¿has probado usar application.undo?

Esto restablecerá los valores nuevamente. Luego puede simplemente leer el valor original. No debería ser demasiado difícil almacenar primero los nuevos valores, por lo que los volverá a cambiar si lo desea.

Answer 6

Tengo una solución alternativa para ti. Podría crear una hoja de cálculo oculta para mantener los valores anteriores para su rango de interés.

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

Eliminar cuando el libro de trabajo está cerrado ...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

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

End Sub

Y modifique su evento Worksheet_Change así ...

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 7

Tuve la necesidad de capturar y comparar valores antiguos con los nuevos valores ingresados ​​en una hoja de cálculo de programación compleja. Necesitaba una solución general que funcionara incluso cuando el usuario cambiaba muchas filas al mismo tiempo. La solución implementó una CLASE y una COLECCIÓN de esa clase.

La clase: 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

Hay tres hojas en las que rastreo las celdas. Cada hoja obtiene su propia colección como una variable global en el módulo denominado ProjectPlan de la siguiente manera:

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

El sub de InitDictionaries se llama fuera de worksheet.open para establecer las colecciones.

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

Hay tres módulos utilizados para administrar cada colección de objetos de Valor anterior que son Agregar, Existe y Valor.

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

El levantamiento de objetos pesados ​​se realiza en la devolución de llamada de Worksheet_SelectionChange. Uno de los cuatro se muestra a continuación. La única diferencia es la colección utilizada en las llamadas ADD y 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

La llamada de VALOR se llama fuera del código ejecutado desde la Hoja de trabajo_Cambio de devolución de llamada, por ejemplo. Necesito asignar la colección correcta en función del nombre de la hoja:

   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

y luego soy libre de calcular, comparo el cierto valor actual con el valor original.

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

marca

Answer 8

Usar Static resolverá tu problema (con algunas otras cosas para inicializar old_value correctamente:

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

En el código de libro de trabajo, fuerza la llamada de Worksheet_change de old_value para llenar old_value :

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

Sin embargo, tenga en cuenta que CUALQUIER solución basada en variables VBA (incluido el diccionario y otros métodos más sofisticados) fallará si detiene (Restablece) el código en ejecución (por ejemplo, mientras crea nuevas macros, depura algún código, ...). Para evitarlo, considere usar métodos de almacenamiento alternativos (hoja de trabajo oculta, por ejemplo).

Answer 9

Veamos primero cómo detectar y guardar el valor de una sola celda de interés. Supongamos que Worksheets(1).Range("B1") es su celda de interés. En un módulo normal, usa esto:

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

Luego, en el módulo de hojas de trabajo (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

Esto capturará el cambio de las Worksheets(1).Range("B1") de Worksheets(1).Range("B1") , si el cambio se debe a que el usuario selecciona activamente esa celda en la Hoja de trabajo y cambia el valor, o debido a otros códigos VBA que cambian el valor de Worksheets(1).Range("B1") .

Como hemos declarado la variable StorageArray como pública, puede hacer referencia a su último valor en otros módulos en el mismo proyecto de VBA.

Para ampliar nuestro alcance a la detección y guardar los valores de múltiples celdas de interés, debe:

• Declare StorageArray como una matriz bidimensional, con el número de filas igual al número de celdas que está monitoreando.
• Modifique el procedimiento Sub SaveToStorageArray a un Sub SaveToStorageArray(TargetSingleCell as Range) más general Sub SaveToStorageArray(TargetSingleCell as Range) y cambie los códigos relevantes.
• Modifique el procedimiento Private Sub Worksheet_Change para acomodar el monitoreo de esas celdas múltiples.

Apéndice: para obtener más información sobre la vida útil de las variables, consulte: https://msdn.microsoft.com/en-us/library/office/gg278427.aspx

Answer 10

Yo también tuve que hacerlo. Encontré la solución de "Chris R" realmente buena, pero pensé que podría ser más compatible al no agregar ninguna referencia. Chris, hablaste de usar Collection. Entonces aquí hay otra solución usando Collection. Y no es tan lento, en mi caso. Además, con esta solución, al agregar el evento "_SelectionChange", siempre está funcionando (sin necesidad de 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 11

intenta esto, no funcionará para la primera selección, entonces funcionará bien :)

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 12

prueba esto

declarar una variable say

Dim oval

y en el evento SelectionChange

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

y en su conjunto de eventos Worksheet_Change

old_value = oval

Answer 13

una idea ...

• escríbalos en el módulo ThisWorkbook
• cerrar y abrir el libro de trabajo

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 14

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