Note: The other languages of the website are Google-translated. Back to English

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 unelte > 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 Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

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!
fundul officetab
Comentarii (20)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Am nevoie de așa ceva, dar numai în anumite celule (ex.: G12 pentru a afișa în H23 valoarea veche)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Și altele... Am nevoie de această rulare atunci când o celulă se schimbă cu un rezultat (EX.: A1 + B1 = C1... dacă schimb valoarea A sau B, scriptul nu funcționează - nu se întâmplă nimic în celula G)
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut ! Am vrut doar sa stiu daca este posibil sa inregistrez multiple modificari in celula, adica daca pun date in celula C2 si apoi schimb acele date pentru alte informatii, datele anterioare trec in celula G2 (ca in aceasta postare). ), dar dacă mai schimb o dată valoarea în celula C2, a doua modificare pe care am făcut-o trece la celula H2 (de exemplu) și acum am înregistrat informațiile celor 3 mișcări pe care le-am realizat, și o fac de aproape 5 ori mai mult (salvați valoarea celulei anterioare de 5 ori). Dacă m-ai putea ajuta, aș aprecia foarte mult pentru că aici, în postarea ta, este singurul loc pe care l-am găsit unde îmi rezolv parțial problema. Multumesc pentru partajarea acestui continut!!!!
Acest comentariu a fost redus la minimum de moderatorul de pe site
ai gasit cum sa faci asta?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mă gândeam la o propoziție „Dacă/altfel”, dar sunt nou în utilizarea VBA, așa că dacă aveți o altă postare care m-ar putea ajuta, vă rog să-mi împărtășiți și din nou vă mulțumesc! continuă să împărtășești cunoștințele
Acest comentariu a fost redus la minimum de moderatorul de pe site
De ce codul de mai sus nu funcționează pentru datele DDE, am o date într-o coloană care se schimbă prin dde, dar în momentul în care am aplicat acest cod pentru a salva valoarea anterioară a acelei coloane într-o altă coloană, nu face nimic;

Orice ajutor pentru a realiza acest lucru este foarte apreciat.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Hi!

Funcție grozavă, dar cum poate fi modificată pentru a funcționa și cu o celulă. Vreau să memorez valoarea care conține VLOOKUP? Din păcate, nu am putut găsi ce să modific pentru a salva valoarea din VLOOKUP. Așa cum este, nu funcționează când VLOOKUP-urile sunt la mijloc :(

Multumesc anticipat pentru ajutor!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună ziua, am modificat codul „Codul VBA: Salvați valoarea celulei anterioare într-o altă celulă de coloană” pe care l-ați creat, totuși am câteva întrebări:

1. Cum știe codul care coloană are noile valori? (care după o altă actualizare ar avea valorile în cealaltă coloană)
2. Cum poți transforma asta într-o macro? Sau faceți-l să ruleze automat când un alt program apelează xlsm. fişier?

mulțumesc
Acest comentariu a fost redus la minimum de moderatorul de pe site
Aceasta este pentru o valoare de celulă, dar cum se face pentru o valoare a mai multor celule, vreau să stocheze date de 4 celule și să actualizez astfel, de exemplu, datele celulei C, D, E, F în celula G, H, I, J, respectiv, cum se poate face te rog ajuta-ma
Acest comentariu a fost redus la minimum de moderatorul de pe site
Dacă celula pe care vreau să o salvez este o formulă, celula G va salva doar formula și va calcula valoarea. Trebuie să salvez valoarea - nu formula. Cum pot spune codului VBA că valoarea se schimbă, deși formula nu este schimbată. Salutări Flemming
Acest comentariu a fost redus la minimum de moderatorul de pe site
Există vreo modalitate de a repeta acest lucru pentru toate modificările? Aș dori că caseta de comentarii să arate toate intrările anterioare, dacă este posibil.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Jennie! Ai reusit sa rezolvi aceasta problema? De asemenea, încerc să adun într-o casetă de comentarii toate noile intrări, dar întâmpin dificultăți în a adapta codul VBA la asta. Mulțumesc!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Este bine dacă tastați. Mă puteți ajuta să lucrez atunci când datele sunt introduse utilizând și valoarea funcției din DDE (Dynamic Data Exchange)?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,
Îmi pare rău că nu pot rezolva această problemă. Vă sugerez să postați problema pe forumul de mai jos pentru a obține ajutor de la alți pasionați de Excel.
https://www.extendoffice.com/forum/kutools-for-excel.html
Acest comentariu a fost redus la minimum de moderatorul de pe site
cho e hỏi chút là có cách nào để khi tính toán cộng trừ xong thì nó sẽ lưu lại giá trị khi tính toán xong không ạ
ví dụ:
Giá trị ở cột A = cột B + cột C
Khi tính toán xong cột a sẽ lưu giá trị sau khi đã tính toán xong, lần tiếp theo tính toán thì nó cột a sẽ lấy giá trị hiện tại ể tính toán tiếp chứ không lấy giá Trị ban ầp chứ không lấy tính thán tiếp chứ không lấy tính thán ban ầp chứ không lấy giá Trị Ban ầp chứ không lấy giá thán ban ầp chứ không lấy giá Trị Ban ầp Chứ Không lấy Giá Trị Ban Fe
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Trung,
Codul a fost actualizat. Vă rugăm să încercați. Vă mulțumim pentru feedback-ul dumneavoastră.
În codul următor, numărul 5 din această linie Setați xDCell = Cells(xCell.Row, 5) reprezintă coloana E unde vei plasa valoarea anterioară. A:A se referă la celulele din coloana A. Trebuie să salvați valorile anterioare ale acestor celule.

Dim xRg As Range
'Updated by Extendoffice 20220803
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
    Dim X
    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, 5)
        
        xDCell.NumberFormatLocal = xCell.NumberFormatLocal
        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("A:A"))
    End If
Label1:
    Set xRg = Intersect(Target, Range("A:A"))
    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 ' xRgArea(J).Formula
        Next
    Next
    Set xChangeRg = Nothing
    Set xRg = Nothing
    Set xDependRg = Nothing
    Application.EnableEvents = True
End Sub
Acest comentariu a fost redus la minimum de moderatorul de pe site
funcționează numai la introducerea manuală a datelor
dar nu funcționează când datele sunt reîmprospătate de pe un site web
vă rugăm să ajute
Mulțumiri
Acest comentariu a fost redus la minimum de moderatorul de pe site
salvând datele anterioare atunci când introduceți manual, dar nu funcționează când datele sunt reîmprospătate de pe un site web, nu face nimic
vă rugăm să ajute
Mulțumiri
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Kamal.
Această problemă este puțin complicată. După ce am încercat diverse metode, nu pot face față. Imi pare rau pentru aia.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Poate orice organism să ajute în această problemă
Nu există comentarii postate aici încă
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL