Πώς να θυμάστε ή να αποθηκεύσετε την προηγούμενη τιμή κελιού ενός αλλαγμένου κελιού στο Excel;
Κανονικά, κατά την ενημέρωση ενός κελιού με νέο περιεχόμενο, η προηγούμενη τιμή θα καλύπτεται εκτός εάν αναιρέσετε τη λειτουργία στο Excel. Ωστόσο, εάν θέλετε να διατηρήσετε την προηγούμενη τιμή για σύγκριση με την ενημερωμένη, η αποθήκευση της προηγούμενης τιμής κελιού σε άλλο κελί ή στο σχόλιο κελιού θα είναι μια καλή επιλογή. Η μέθοδος σε αυτό το άρθρο θα σας βοηθήσει να το πετύχετε.
Αποθηκεύστε την προηγούμενη τιμή κελιού με κώδικα VBA στο Excel
Αποθηκεύστε την προηγούμενη τιμή κελιού με κώδικα VBA στο Excel
Ας υποθέσουμε ότι έχετε έναν πίνακα όπως φαίνεται στο παρακάτω στιγμιότυπο οθόνης. Εάν κάποιο κελί στη στήλη C άλλαξε, θέλετε να αποθηκεύσετε την προηγούμενη τιμή του στο αντίστοιχο κελί της στήλης G ή να αποθηκεύσετε αυτόματα στο σχόλιο. Κάντε τα εξής για να το πετύχετε.
1. Στο φύλλο εργασίας περιέχει την τιμή που θα αποθηκεύσετε κατά την ενημέρωση, κάντε δεξί κλικ στην καρτέλα του φύλλου και επιλέξτε Προβολή κωδικού από το μενού με δεξί κλικ. Δείτε το στιγμιότυπο οθόνης:
2. Στο άνοιγμα Microsoft Visual Basic για εφαρμογές παράθυρο, αντιγράψτε τον παρακάτω κώδικα VBA στο παράθυρο Code.
Ο ακόλουθος κώδικας VBA σάς βοηθά να αποθηκεύσετε την προηγούμενη τιμή κελιού της καθορισμένης στήλης σε άλλη στήλη.
Κωδικός VBA: Αποθηκεύστε την προηγούμενη τιμή κελιού σε άλλο κελί στήλης
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Για να αποθηκεύσετε την προηγούμενη τιμή κελιού σε ένα σχόλιο, εφαρμόστε τον παρακάτω κώδικα VBA
Κωδικός VBA: Αποθηκεύστε την προηγούμενη τιμή κελιού στο σχόλιο
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 SubNote: Στον κωδικό, ο αριθμός 7 υποδεικνύει τη στήλη G στην οποία θα αποθηκεύσετε το προηγούμενο κελί και το C:C είναι η στήλη στην οποία θα αποθηκεύσετε την τιμή του προηγούμενου κελιού. Αλλάξτε τα ανάλογα με τις ανάγκες σας.
3. κλικ Εργαλεία > αναφορές για να ανοίξετε το Αναφορές – VBAProject πλαίσιο ελέγχου, ελέγξτε το Χρόνος εκτέλεσης δέσμης ενεργειών Microsoft πλαίσιο και, τέλος, κάντε κλικ στο OK κουμπί. Δείτε το στιγμιότυπο οθόνης:
4. Πάτα το άλλος + Q πλήκτρα για να κλείσετε το Microsoft Visual Basic για εφαρμογές παράθυρο.
Από εδώ και στο εξής, όταν ενημερωθεί η τιμή του κελιού στη στήλη C, η προηγούμενη τιμή του κελιού θα αποθηκεύεται στα αντίστοιχα κελιά της στήλης G ή θα αποθηκεύεται στο σχόλιο όπως εμφανίζονται παρακάτω τα στιγμιότυπα οθόνης.
Αποθήκευση προηγούμενων τιμών κελιών σε άλλα κελιά:
Αποθηκεύστε προηγούμενες τιμές κελιών στα σχόλια:
Τα καλύτερα εργαλεία παραγωγικότητας γραφείου
Αυξήστε τις δεξιότητές σας στο Excel με τα Kutools για Excel και απολαύστε την αποτελεσματικότητα όπως ποτέ πριν. Το Kutools για Excel προσφέρει πάνω από 300 προηγμένες δυνατότητες για την ενίσχυση της παραγωγικότητας και την εξοικονόμηση χρόνου. Κάντε κλικ εδώ για να αποκτήσετε τη δυνατότητα που χρειάζεστε περισσότερο...
Το Office Tab φέρνει τη διεπαφή με καρτέλες στο Office και κάνει την εργασία σας πολύ πιο εύκολη
- Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
- Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
- Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
