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

كيف تتذكر أو تحفظ قيمة الخلية السابقة لخلية تم تغييرها في إكسيل؟

عادةً ، عند تحديث خلية بمحتوى جديد ، ستتم تغطية القيمة السابقة ما لم يتم التراجع عن العملية في 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 ، أو حفظها في التعليق كما هو موضح أدناه.

احفظ قيم الخلايا السابقة في خلايا أخرى:

احفظ قيم الخلايا السابقة في التعليقات:


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (20)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أحتاج إلى شيء من هذا القبيل ، ولكن فقط في خلايا محددة (على سبيل المثال: G12 لإظهار القيمة القديمة في H23)
تم تصغير هذا التعليق بواسطة المشرف على الموقع
وغير ذلك ... أحتاج إلى هذا التشغيل عندما تتغير خلية من خلال نتيجة (على سبيل المثال: A1 + B1 = C1 ... إذا قمت بتغيير قيمة A أو B ، فلن يعمل البرنامج النصي - لا يحدث شيء في الخلية G)
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أهلاً ! أردت فقط معرفة ما إذا كان من الممكن تسجيل تغييرات متعددة في الخلية ، أعني ، إذا وضعت بيانات في الخلية C2 ثم قمت بتغيير تلك البيانات للحصول على معلومات أخرى ، فإن البيانات السابقة تنتقل إلى الخلية G2 (كما في هذا المنشور ) ، ولكن إذا قمت بتغيير القيمة مرة أخرى في الخلية C2 ، فإن التغيير الثاني الذي أجريته يمر إلى الخلية H2 (على سبيل المثال) والآن قمت بتسجيل معلومات الحركات الثلاث التي أدركتها ، وقمت بذلك تقريبًا 3 مرات المزيد (احفظ قيمة الخلية السابقة 5 مرات). إذا كنت تستطيع مساعدتي ، فسأكون ممتنًا للغاية لأنه هنا في رسالتك ، إنه المكان الوحيد الذي وجدت فيه حل مشكلتي جزئيًا. شكرا لتقاسم هذا المحتوى !!!!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل وجدت كيف تفعل هذا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
كنت أفكر في جملة "If / else" لكنني جديد باستخدام VBA ، لذلك إذا كان لديك منشور آخر يمكن أن يساعدني ، يرجى مشاركته معي ، ومرة ​​أخرى شكرًا لك! استمر في مشاركة المعرفة
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لماذا لا يعمل الرمز أعلاه مع بيانات DDE ، لدي بيانات في عمود يتغير من خلال dde ، ولكن في اللحظة التي قمت فيها بتطبيق هذا الرمز لحفظ القيمة السابقة لهذا العمود في عمود آخر ، لم أفعل أي شيء ؛

أي مساعدة لتحقيق هذا هو موضع تقدير كبير.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا!

وظيفة رائعة ولكن كيف يمكن تعديلها لتعمل أيضًا مع خلية أريد حفظ القيمة التي تحتوي عليها VLOOKUP؟ لسوء الحظ ، لم أتمكن من العثور على ما يجب تعديله لحفظ القيمة من VLOOKUP. لأنه لا يعمل عندما تكون وحدات VLOOKUP في المنتصف :(

شكرا مقدما لمساعدتكم !
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، تم تعديل رمز "رمز VBA: حفظ قيمة الخلية السابقة في خلية عمود أخرى" الذي قمت بإنشائه ، ولكن لدي سؤالان:

1. كيف تعرف الشفرة العمود الذي يحتوي على القيم الجديدة؟ (والتي ستظهر قيمها في العمود الآخر بعد تحديث آخر)
2. كيف يمكنك تحويل هذا إلى ماكرو؟ أو قم بتشغيله تلقائيًا عندما يقوم برنامج آخر باستدعاء xlsm. ملف؟

شكر
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هذا لقيمة خلية واحدة ، ولكن كيف يتم ذلك بالنسبة لقيمة خلية متعددة ، أريد تخزين 4 بيانات خلية وتحديث مثل هذا على سبيل المثال بيانات الخلية C ، D ، E ، F في خلية G ، H ، I ، J على التوالي ، كيف يمكن القيام بذلك الرجاء المساعدة
تم تصغير هذا التعليق بواسطة المشرف على الموقع
إذا كانت الخلية التي أريد حفظها عبارة عن صيغة ، فإن الخلية G ستحفظ الصيغة فقط وتحسب القيمة. أحتاج إلى حفظ القيمة - وليس الصيغة. كيف يمكنني معرفة كود VBA ، أن القيمة تتغير على الرغم من عدم تغيير الصيغة. مع أطيب التحيات فليمنغ
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل هناك طريقة لتكرار هذا مع كل التغييرات؟ أود أن يظهر مربع التعليقات جميع الإدخالات السابقة إن أمكن.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا جيني! هل تمكنت من حل هذه المشكلة؟ أحاول أيضًا أن أجمع في مربع التعليقات جميع الإدخالات الجديدة ، لكني أواجه صعوبات في تكييف كود VBA مع هذا. شكرًا لك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
من الجيد أن تقوم بالكتابة. هل يمكنك مساعدتي في العمل عند إدخال البيانات باستخدام قيمة الوظيفة من DDE (تبادل البيانات الديناميكي) أيضًا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
آسف لا أستطيع حل هذه المشكلة. أقترح عليك نشر المشكلة في المنتدى أدناه للحصول على مساعدة من عشاق Excel الآخرين.
https://www.extendoffice.com/forum/kutools-for-excel.html
تم تصغير هذا التعليق بواسطة المشرف على الموقع
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 ạ
في اليوم:
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 toy tip
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ترونج ،
تم تحديث الرمز. يرجى محاولة إعطائها. شكرا لملاحظاتك.
في الكود التالي ، الرقم 5 في هذا السطر تعيين xDCell = خلايا (xCell.Row ، 5) يمثل العمود E حيث ستضع القيمة السابقة. ج: يشير A إلى الخلايا الموجودة في العمود A. تحتاج إلى حفظ القيم السابقة لهذه الخلايا.

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
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يعمل فقط عند إدخال البيانات يدويًا
ولكن لا يعمل عندما يتم تحديث البيانات من موقع ويب
الرجاء المساعدة
شكر
تم تصغير هذا التعليق بواسطة المشرف على الموقع
حفظ البيانات السابقة عند إدخالها يدويًا ولكن لا تعمل عندما يتم تحديث البيانات من موقع ويب ، فإنه لا يفعل شيئًا
الرجاء المساعدة
شكر
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كمال.
هذه المشكلة معقدة بعض الشيء. بعد تجربة طرق مختلفة ، لا يمكنني التعامل معها. أنا آسف لذلك.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يمكن لأي شخص أن يساعد في هذه المشكلة
لا توجد تعليقات منشورة هنا حتى الآن

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL