Cum să vă amintiți sau să salvați valoarea celulei anterioare a unei celule modificate în Excel?
În mod normal, atunci când actualizați o celulă cu conținut nou, valoarea anterioară va fi acoperită dacă nu anulați operația în Excel. Cu toate acestea, dacă doriți să păstrați valoarea anterioară pentru comparare cu cea actualizată, salvarea valorii celulei anterioare într-o altă celulă sau în comentariul celulei va fi o alegere bună. Metoda din acest articol vă va ajuta să o realizați.
Salvați valoarea celulei anterioare cu codul VBA în Excel
Salvați valoarea celulei anterioare cu codul VBA în Excel
Să presupunem că aveți un tabel așa cum este prezentat mai jos. Dacă s-a modificat orice celulă din coloana C, doriți să salvați valoarea sa anterioară în celula corespunzătoare a coloanei G sau să salvați automat în comentariu. Vă rugăm să faceți următoarele pentru a o realiza.
1. În foaia de lucru conține valoarea pe care o veți salva la actualizare, faceți clic dreapta pe fila foaie și selectați Afișați codul din meniul cu clic dreapta. Vedeți captura de ecran:
2. În deschidere Microsoft Visual Basic pentru aplicații , copiați codul VBA de mai jos în fereastra Cod.
Următorul cod VBA vă ajută să salvați valoarea celulei anterioare a coloanei specificate într-o altă coloană.
Cod VBA: Salvați valoarea celulei anterioare într-o altă celulă coloană
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 Sub
Pentru a salva valoarea celulei anterioare într-un comentariu, vă rugăm să aplicați codul VBA de mai jos
Cod VBA: Salvați valoarea celulei anterioare în comentariu
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 Sub
notițe: În cod, numărul 7 indică coloana G în care veți salva celula anterioară, iar C: C este coloana în care veți salva valoarea celulei anterioare. Vă rugăm să le schimbați în funcție de nevoile dvs.
3. clic Instrumente > Referinte pentru a deschide Referințe - VBAProject caseta de dialog, verificați Runtime Microsoft Scripting , apoi faceți clic pe butonul OK buton. Vedeți captura de ecran:
4. apasă pe Alt + Q tastele pentru a închide Microsoft Visual Basic pentru aplicații fereastră.
De acum înainte, când valoarea celulei din coloana C a fost actualizată, valoarea anterioară a celulei va fi salvată în celulele corespunzătoare din coloana G sau se va salva în comentariu așa cum au arătat capturile de ecran de mai jos.
Salvați valorile anterioare ale celulelor în alte celule:
Salvați valorile celulelor anterioare în comentarii:
Cele mai bune instrumente de productivitate de birou
Îmbunătățiți-vă abilitățile Excel cu Kutools pentru Excel și experimentați eficiența ca niciodată. Kutools pentru Excel oferă peste 300 de funcții avansate pentru a crește productivitatea și a economisi timp. Faceți clic aici pentru a obține funcția de care aveți cea mai mare nevoie...
Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară
- Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
- Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ferestrele noi.
- Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!