Hur kommer jag ihåg eller sparar tidigare cellvärde för en ändrad cell i Excel?
Normalt, när du uppdaterar en cell med nytt innehåll, kommer det tidigare värdet att täckas om inte åtgärden ångras i Excel. Men om du vill behålla det tidigare värdet för att jämföra med det uppdaterade, är det ett bra val att spara det tidigare cellvärdet i en annan cell eller i cellkommentaren. Metoden i den här artikeln hjälper dig att uppnå det.
Spara tidigare cellvärde med VBA-kod i Excel
Spara tidigare cellvärde med VBA-kod i Excel
Antar att du har en tabell som visas nedan. Om någon cell i kolumn C ändras vill du spara dess tidigare värde i motsvarande cell i kolumn G eller spara i kommentar automatiskt. Gör så här för att uppnå det.
1. I kalkylbladet innehåller det värde du kommer att spara när du uppdaterar, högerklicka på arkfliken och välj Visa kod från högerklickmenyn. Se skärmdump:
2. I öppningen Microsoft Visual Basic för applikationer kopiera nedanstående VBA-kod till kodfönstret.
Följande VBA-kod hjälper dig att spara tidigare cellvärde för angiven kolumn i en annan kolumn.
VBA-kod: Spara tidigare cellvärde i en annan kolumncell
Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
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, 7)
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("C:C"))
End If
Label1:
Set xRg = Intersect(Target, Range("C:C"))
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 SubFör att spara det tidigare cellvärdet i en kommentar, använd VBA-koden nedan
VBA-kod: Spara tidigare cellvärde i kommentaren
Dim xRg As Range
Dim xChangeRg As Range
Dim xDependRg As Range
Dim xDic As New Dictionary
Private Sub Worksheet_Change(ByVal Target As Range)
Dim I As Long
Dim xCell As Range
Dim xHeader As String
Dim xCommText As String
On Error Resume Next
Application.ScreenUpdating = False
Application.EnableEvents = False
xHeader = "Previous value :"
For I = 0 To UBound(xDic.Keys)
Set xCell = Range(xDic.Keys(I))
If Not xCell.Comment Is Nothing Then xCell.Comment.Delete
With xCell
.AddComment
.Comment.Visible = False
.Comment.Text xHeader & vbCrLf & xDic.Items(I)
End With
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("C:C"))
End If
Label1:
Set xRg = Intersect(Target, Range("C:C"))
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).Text
Next
Next
Set xChangeRg = Nothing
Set xRg = Nothing
Set xDependRg = Nothing
Application.EnableEvents = True
End SubAnmärkningar: I koden indikerar nummer 7 kolumnen G du kommer att spara den föregående cellen i, och C: C är den kolumn som du kommer att spara det tidigare cellvärdet. Ändra dem baserat på dina behov.
3. klick verktyg > Referensprojekt att öppna Referenser - VBAProject dialogrutan, kolla på Microsoft Scripting Runtime och slutligen klicka på OK knapp. Se skärmdump:
4. tryck på andra + Q för att stänga Microsoft Visual Basic för applikationer fönster.
Från och med nu, när cellvärdet i kolumn C uppdateras, kommer det tidigare värdet i cellen att sparas i motsvarande celler i kolumn G, eller spara i kommentar som nedan visas skärmdumpar.
Spara tidigare cellvärden i andra celler:
Spara tidigare cellvärden i kommentarer:
Bästa kontorsproduktivitetsverktyg
Uppgradera dina Excel-färdigheter med Kutools för Excel och upplev effektivitet som aldrig förr. Kutools för Excel erbjuder över 300 avancerade funktioner för att öka produktiviteten och spara tid. Klicka här för att få den funktion du behöver mest...
Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare
- Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
- Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
- Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
