كيف تتذكر أو تحفظ قيمة الخلية السابقة لخلية تم تغييرها في إكسيل؟
عادةً ، عند تحديث خلية بمحتوى جديد ، ستتم تغطية القيمة السابقة ما لم يتم التراجع عن العملية في Excel. ومع ذلك ، إذا كنت تريد الاحتفاظ بالقيمة السابقة للمقارنة بالقيمة المحدثة ، فسيكون حفظ قيمة الخلية السابقة في خلية أخرى أو في تعليق الخلية اختيارًا جيدًا. ستساعدك الطريقة في هذه المقالة على تحقيق ذلك.
احفظ قيمة الخلية السابقة برمز VBA في Excel
احفظ قيمة الخلية السابقة برمز VBA في Excel
لنفترض أن لديك جدولًا كما هو موضح أدناه. إذا تم تغيير أي خلية في العمود C ، فأنت تريد حفظ قيمتها السابقة في الخلية المقابلة للعمود G أو حفظها في التعليق تلقائيًا. يرجى القيام بما يلي لتحقيق ذلك.
1. في ورقة العمل تحتوي على القيمة التي ستحفظها عند التحديث ، انقر بزر الماوس الأيمن فوق علامة تبويب الورقة وحدد عرض الرمز من قائمة النقر بزر الماوس الأيمن. انظر لقطة الشاشة:
2. في الافتتاح ميكروسوفت فيسوال باسيك للتطبيقات نافذة ، انسخ رمز فبا أدناه في نافذة التعليمات البرمجية.
يساعدك رمز 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 أدناه
كود فبا: احفظ قيمة الخلية السابقة في التعليق
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
ملاحظات: في الكود ، يشير الرقم 7 إلى العمود G الذي ستحفظ الخلية السابقة فيه ، و C: C هو العمود الذي ستحفظ فيه قيمة الخلية السابقة. يرجى تغييرها بناءً على احتياجاتك.
3. انقر الأدوات > مراجع حسابات لفتح المراجع - VBAProject مربع الحوار، والتحقق من وقت تشغيل البرمجة لـ Microsoft مربع ، وأخيراً انقر فوق OK زر. انظر لقطة الشاشة:
4. اضغط على قديم + Q مفاتيح لإغلاق ميكروسوفت فيسوال باسيك للتطبيقات نافذة.
من الآن فصاعدًا ، عند تحديث قيمة الخلية في العمود C ، سيتم حفظ القيمة السابقة للخلية في الخلايا المقابلة في العمود G ، أو حفظها في التعليق كما هو موضح أدناه.
احفظ قيم الخلايا السابقة في خلايا أخرى:
احفظ قيم الخلايا السابقة في التعليقات:
أفضل أدوات إنتاجية المكتب
عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت. انقر هنا للحصول على الميزة التي تحتاجها أكثر...
يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير
- تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
- فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
- يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!