web-dev-qa-db-de.com

Wie erhalte ich den alten Wert einer geänderten Zelle in Excel VBA?

Ich entdecke Änderungen in den Werten bestimmter Zellen in einer Excel-Tabelle wie folgt ...

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

Angenommen, dies ist keine schlechte Methode, um dies zu codieren. Wie erhalte ich den Wert der Zelle vor der Änderung?

39
Brian Hooper

versuche dies

deklarieren Sie eine Variable sagen

Dim oval

und im SelectionChange-Ereignis

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

und in Ihrem Worksheet_Change-Ereignissatz

old_value = oval
49
Binil

Sie können ein Ereignis für die Zellenänderung verwenden, um ein Makro auszulösen, das Folgendes ausführt:

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

Ich habe eine alternative Lösung für Sie. Sie können ein verstecktes Arbeitsblatt erstellen, um die alten Werte für Ihren Interessenbereich zu erhalten. 

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

Löschen Sie es, wenn die Arbeitsmappe geschlossen ist ...

Private Sub Workbook_BeforeClose(Cancel As Boolean)

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

End Sub

Und ändern Sie Ihr Worksheet_Change-Ereignis wie folgt ...

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)
10
Nick Spreitzer

Hier ist ein Weg, den ich in der Vergangenheit benutzt habe. Beachten Sie, dass Sie einen Verweis auf die Microsoft Scripting Runtime hinzufügen müssen, damit Sie das Dictionary-Objekt verwenden können. Wenn Sie diesen Verweis nicht hinzufügen möchten, können Sie dies mit Collections tun, aber sie sind langsamer und es gibt keine elegante Möglichkeit zur Überprüfung .Exists (Sie müssen den Fehler abfangen).

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

Wie bei jeder ähnlichen Methode hat dies auch Probleme: Erstens kennt es den "alten" Wert nicht, bis der Wert tatsächlich geändert wurde. Um dies zu beheben, müssen Sie das Open-Ereignis in der Arbeitsmappe abfangen und Sheet.UsedRange mit OldVals auffüllen. Außerdem gehen alle Daten verloren, wenn Sie das VBA-Projekt zurücksetzen, indem Sie den Debugger oder einen anderen starten.

8
Chris Rae

Ich musste es auch tun. Ich fand die Lösung von "Chris R" wirklich gut, dachte aber, dass es besser wäre, wenn man keine Referenzen hinzufügt. Chris, du hast über die Verwendung von Collection gesprochen. Hier ist also eine andere Lösung, die Collection verwendet. Und in meinem Fall ist es nicht so langsam. Mit dieser Lösung funktioniert das Hinzufügen des Ereignisses "_SelectionChange" immer (es ist kein workbook_open erforderlich).

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
8
Matt Roy

eine Idee ...

  • schreiben Sie diese in das Modul ThisWorkbook
  • schließen und öffnen Sie die Arbeitsmappe
 Public LastCell As Range 

 Private Sub Workbook_Open () 

 Set LastCell = ActiveCell 

 End Sub

 Private Sub Workbook_SheetSelectionChange (ByVal Sh As-Objekt, ByVal-Ziel als Bereich) 

 Set oa = LastCell.Comment 

 Wenn nicht oa nichts ist, dann __. LastCell.Comment.Delete 
 End If 

 Target.AddComment Target.Address 
 Target.Comment.Visible = True 
 Set LastCell = ActiveCell 

 End Sub
3
sarmiento

Ich musste alte Werte erfassen und mit den neuen Werten vergleichen, die in eine komplexe Kalkulationstabelle eingegeben wurden. Ich brauchte eine allgemeine Lösung, die auch dann funktionierte, wenn der Benutzer viele Zeilen gleichzeitig geändert hat. Die Lösung implementierte eine KLASSE und eine SAMMLUNG dieser Klasse.

Die Klasse: 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

Es gibt drei Seiten, in denen ich Zellen nachverfolgen kann. Jedes Blatt erhält seine eigene Sammlung als globale Variable in dem Modul mit dem Namen ProjectPlan wie folgt:

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

Die InitDictionary SUB wird aus Worksheet.open aufgerufen, um die Sammlungen zu erstellen.

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

Es gibt drei Module, die zum Verwalten jeder Sammlung von oldValue-Objekten verwendet werden, nämlich Add, Exists und 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

Das schwere Anheben wird im Callback von Worksheet_SelectionChange durchgeführt. Eine der vier ist unten gezeigt. Der einzige Unterschied besteht in der Sammlung, die in den Aufrufen ADD und EXIST verwendet wird.

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

Der VALUE-Aufruf wird außerhalb des Codes aufgerufen, der beispielsweise vom Worksheet_Change-Callback ausgeführt wird. Ich muss die korrekte Sammlung anhand des Blattnamens zuweisen:

   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

und dann bin ich frei, den aktuellen Wert mit dem ursprünglichen Wert zu vergleichen.

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

Kennzeichen

1
Radiumcola

Sehen wir uns zunächst an, wie Sie den Wert einer einzelnen Zelle von Interesse ermitteln und speichern können. Angenommen, Worksheets(1).Range("B1") ist Ihre interessierende Zelle. Verwenden Sie in einem normalen Modul Folgendes:

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

Dann im Modul der Arbeitsblätter (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

Dadurch wird die Änderung von Worksheets(1).Range("B1") erfasst, unabhängig davon, ob die Änderung darauf zurückzuführen ist, dass der Benutzer diese Zelle auf dem Arbeitsblatt aktiv auswählt und den Wert ändert, oder dass andere VBA-Codes den Wert von Worksheets(1).Range("B1") ändern.

Da wir die Variable StorageArray als öffentlich deklariert haben, können Sie ihren neuesten Wert in anderen Modulen des gleichen VBA-Projekts angeben.

Um unseren Geltungsbereich auf die Erkennung und Speicherung der Werte mehrerer interessierender Zellen zu erweitern, müssen Sie:

  • Deklarieren Sie die Variable StorageArray als zweidimensionales Array, wobei die Anzahl der Zeilen der Anzahl der überwachten Zellen entspricht.
  • Ändern Sie die Sub SaveToStorageArray-Prozedur in eine allgemeinere Sub SaveToStorageArray(TargetSingleCell as Range) und ändern Sie die __. Relevanten Codes.
  • Ändern Sie die Private Sub Worksheet_Change-Prozedur, um die Überwachung dieser mehreren Zellen zu ermöglichen.

Anhang: Weitere Informationen zur Lebensdauer von Variablen finden Sie unter: https://msdn.Microsoft.com/en-us/library/office/gg278427.aspx

1
PaulDragoonM

Ich habe das gleiche Problem wie Sie und zum Glück habe ich die Lösung über diesen Link gelesen: http://access-Excel.tips/value-before-worksheet-change/

Dim oldValue As Variant
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    oldValue = Target.Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    'do something with oldValue...
End Sub

Hinweis: Sie müssen die Variable oldValue als globale Variable platzieren, damit alle Unterklassen sie verwenden können.

1

Als Antwort auf die Antwort von Matt Roy fand ich diese Option eine großartige Antwort, obwohl ich mit meiner aktuellen Bewertung nicht als solche posten konnte. :(

Während ich jedoch die Gelegenheit nutzte, um meine Gedanken zu seiner Antwort zu posten, dachte ich, ich würde die Gelegenheit nutzen, um eine kleine Modifikation hinzuzufügen. Vergleichen Sie einfach den Code, um zu sehen.

Vielen Dank an Matt Roy, der uns auf diesen Code aufmerksam gemacht hat, und Chris.R für die Veröffentlichung des Originalcodes.

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
1
John Douglas

probieren Sie dies aus, es wird nicht für die erste Auswahl funktionieren, dann wird es Nizza funktionieren :)

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
1
Najar

Ich brauchte dieses Feature und ich mochte nicht alle oben genannten Lösungen, nachdem ich die meisten probiert hatte, da sie beide sind

  1. Schleppend 
  2. Haben Sie komplexe Implikationen wie etwa application.undo. 
  3. Nicht aufnehmen, wenn sie nicht ausgewählt wurden
  4. Erfasst keine Werte, wenn diese zuvor nicht geändert wurden
  5. Zu komplex

Nun, ich habe sehr darüber nachgedacht und eine Lösung für eine komplette UNDO, REDO-Geschichte erstellt.

Den alten Wert zu erfassen ist eigentlich sehr einfach und sehr schnell.

Meine Lösung besteht darin, alle Werte zu erfassen, sobald der Benutzer das Blatt in einer Variablen geöffnet hat, und es wird nach jeder Änderung aktualisiert. Diese Variable wird verwendet, um den alten Wert der Zelle zu überprüfen. In den Lösungen vor allem von ihnen für Schleife verwendet. Eigentlich gibt es eine einfachere Methode.

Um alle Werte zu erfassen, habe ich diesen einfachen Befehl verwendet

SheetStore = sh.UsedRange.Formula

Ja, genau das. Actually Excel gibt ein Array zurück, wenn der Bereich aus mehreren Zellen besteht. Daher müssen wir den Befehl FOR EACH nicht verwenden und er ist sehr schnell

Das folgende Sub ist der vollständige Code, der in Workbook_SheetActivate aufgerufen werden sollte. Ein weiteres Sub sollte erstellt werden, um die Änderungen zu erfassen. Ich habe beispielsweise ein Sub namens "catchChanges", das auf Workbook_SheetChange ausgeführt wird. Es erfasst die Änderungen und speichert sie auf einem anderen Änderungsprotokoll. führt dann UpdateCache aus, um den Cache mit den neuen Werten zu aktualisieren

' 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

um den alten Wert zu erhalten, ist es sehr einfach, da das Array die gleiche Zellenadresse hat

beispiele, wenn wir Zelle D12 wollen, können wir die folgenden verwenden 

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)

das sind Ausschnitte, die die Methode erklären, ich hoffe, es gefällt allen

Ich habe diesen alten Beitrag gelesen und möchte eine andere Lösung anbieten.

Das Problem beim Ausführen von Application.Undo ist, dass Woksheet_Change erneut ausgeführt wird. Wir haben das gleiche Problem, wenn wir wiederherstellen.

Um dies zu vermeiden, verwende ich einen Code, um die zweiten Schritte durch Worksheet_Change zu vermeiden.

Bevor wir beginnen, müssen wir eine boolesche statische Variable BlnAlreadyBeenHere erstellen, um Excel anzuweisen, Worksheet_Change nicht erneut auszuführen

Hier können Sie es sehen:

    Private Sub Worksheet_Change(ByVal Target As Range)

    Static blnAlreadyBeenHere As Boolean

    'This piece avoid to execute Worksheet_Change again
    If blnAlreadyBeenHere Then
        blnAlreadyBeenHere = False
        Exit Sub
    End If

    'Now, we will store the old and new value
    Dim vOldValue As Variant
    Dim vNewValue As Variant

    'To store new value
    vNewValue = Target.Value

    'Undo to retrieve old value

    'To avoid new Worksheet_Change execution
    blnAlreadyBeenHere = True

    Application.Undo

    'To store old value
    vOldValue = Target.Value

    'To rewrite new value

    'To avoid new Worksheet_Change execution agein
    blnAlreadyBeenHere = True
    Target.Value = vNewValue

    'Done! I've two vaules stored
    Debug.Print vOldValue, vNewValue

End Sub

Der Vorteil dieser Methode ist, dass Worksheet_SelectionChange nicht ausgeführt werden muss.

Wenn die Routine von einem anderen Modul aus arbeiten soll, müssen wir nur die Deklaration der Variablen blnAlreadyBeenHere aus der Routine nehmen und mit Dim deklarieren.

Gleiche Operation mit vOldValue und vNewValue im Header eines Moduls

Dim blnAlreadyBeenHere As Boolean
Dim vOldValue As Variant
Dim vNewValue As Variant
0
Javier
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
0
Henri1418

Die Verwendung von Static löst Ihr Problem (mit einigen anderen Sachen, um old_value richtig zu initialisieren:

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

Erzwingen Sie im Arbeitsmappencode den Aufruf von Worksheet_change, um old_value zu füllen:

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

Beachten Sie jedoch, dass ANY-Lösungen, die auf VBA-Variablen (einschließlich Wörterbuch und anderen fortgeschritteneren Methoden) basieren, fehlschlagen, wenn Sie den laufenden Code (Reset) stoppen (z. B. beim Erstellen neuer Makros, beim Debuggen von Code, ...). Um dies zu vermeiden, sollten Sie alternative Speichermethoden verwenden (z. B. ein ausgeblendetes Arbeitsblatt).

0
LS_ᴅᴇᴠ