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?
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
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
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)
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.
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
eine Idee ...
ThisWorkbook
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
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
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:
StorageArray
als zweidimensionales Array, wobei die Anzahl der Zeilen der Anzahl der überwachten Zellen entspricht.Sub SaveToStorageArray
-Prozedur in eine allgemeinere Sub SaveToStorageArray(TargetSingleCell as Range)
und ändern Sie die __. Relevanten Codes.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
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.
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
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
Ich brauchte dieses Feature und ich mochte nicht alle oben genannten Lösungen, nachdem ich die meisten probiert hatte, da sie beide sind
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
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
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).