انتقل إلى المحتوى الرئيسي

كيفية تسجيل القيم المتغيرة في خلية في إكسيل؟

كيفية تسجيل كل قيمة متغيرة لخلية متغيرة بشكل متكرر في إكسيل؟ على سبيل المثال ، القيمة الأصلية في الخلية C2 هي 100 ، عند تغيير الرقم 100 إلى 200 ، سيتم عرض القيمة الأصلية 100 في الخلية D2 تلقائيًا للتسجيل. المضي قدما لتغيير 200 إلى 300 ، سيتم إدراج الرقم 200 في الخلية D3 ، والتغيير 300 إلى 400 سيعرض 300 إلى D4 وهكذا. يمكن أن تساعدك الطريقة في هذه المقالة على تحقيق ذلك.

قم بتسجيل القيم المتغيرة في خلية برمز VBA


قم بتسجيل القيم المتغيرة في خلية برمز VBA

يمكن أن يساعدك رمز VBA أدناه في تسجيل كل قيمة متغيرة في خلية في Excel. الرجاء القيام بما يلي.

1. في ورقة العمل تحتوي على الخلية التي تريد تسجيل القيم المتغيرة لها ، انقر بزر الماوس الأيمن فوق علامة تبويب الورقة ثم انقر فوق عرض الرمز من قائمة السياق. انظر لقطة الشاشة:

2. ثم ميكروسوفت فيسوال باسيك للتطبيقات يتم فتح النافذة ، يرجى نسخ رمز VBA أدناه في نافذة التعليمات البرمجية.

كود فبا: سجل القيم المتغيرة في خلية

Dim xVal As String
'Update by Extendoffice 2018/8/22
Private Sub Worksheet_Change(ByVal Target As Range)
    Static xCount As Integer
    Application.EnableEvents = False
    If Target.Address = Range("C2").Address Then
        Range("D2").Offset(xCount, 0).Value = xVal
        xCount = xCount + 1
    Else
        If xVal <> Range("C2").Value Then
         Range("D2").Offset(xCount, 0).Value = xVal
        xCount = xCount + 1
        End If
    End If
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    xVal = Range("C2").Value
End Sub

ملاحظة: في الكود ، C2 هي الخلية التي تريد تسجيل جميع قيمها المتغيرة. D2 هي الخلية التي ستقوم بتعبئة أول قيمة متغيرة لـ C2.

3. اضغط على قديم + Q مفاتيح لإغلاق ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

من الآن فصاعدًا ، في كل مرة تقوم فيها بتغيير القيم في الخلية C2 ، سيتم تسجيل القيم المتغيرة السابقة في D2 والخلايا الموجودة أسفل D2.

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

الميزات الشعبية: البحث عن التكرارات أو تمييزها أو تحديدها   |  حذف الصفوف الفارغة   |  دمج الأعمدة أو الخلايا دون فقدان البيانات   |   جولة بدون صيغة 
سوبر بحث: معايير متعددة VLookup    VLookup ذات القيمة المتعددة  |   VLookup عبر أوراق متعددة   |   بحث غامض ....
قائمة منسدلة متقدمة: إنشاء القائمة المنسدلة بسرعة   |  القائمة المنسدلة التابعة   |  قائمة منسدلة متعددة التحديد ....
مدير العمود: إضافة عدد محدد من الأعمدة  |  نقل الأعمدة  |  تبديل حالة رؤية الأعمدة المخفية  |  مقارنة النطاقات والأعمدة 
الميزات المميزة: التركيز على الشبكة   |  عرض تصميم   |   شريط الفورمولا الكبير    مدير المصنفات والأوراق   |  مكتبة الموارد (النص السيارات)   |  منتقي التاريخ   |  اجمع أوراق العمل   |  تشفير/فك تشفير الخلايا    إرسال رسائل البريد الإلكتروني عن طريق القائمة   |  سوبر تصفية   |   مرشح خاص (تصفية غامق / مائل / يتوسطه خط ...) ...
أفضل 15 مجموعة أدوات12 نص الأدوات (إضافة نص, إزالة الأحرف، ...)   |   +50 رسم الأنواع (مخطط جانت، ...)   |   40+ عملي الصيغ (احسب العمر على أساس تاريخ الميلاد، ...)   |   19 إدخال الأدوات (أدخل رمز الاستجابة السريعة, إدراج صورة من المسار، ...)   |   12 تحويل الأدوات (أرقام إلى كلمات, نتيجة تحويل عملة، ...)   |   7 دمج وتقسيم الأدوات (الجمع بين الصفوف المتقدمة, تقسيم الخلايا، ...)   |   ... و اكثر

عزز مهاراتك في Excel باستخدام Kutools for Excel، واختبر كفاءة لم يسبق لها مثيل. يقدم Kutools for Excel أكثر من 300 ميزة متقدمة لتعزيز الإنتاجية وتوفير الوقت.  انقر هنا للحصول على الميزة التي تحتاجها أكثر...

علامة تبويب kte 201905


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

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
Comments (50)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi,

Not sure if this post is still open but hoping you can help me...

I have a large data set with multiple columns, and rows, that I use for reporting but occasionally I need to overwrite any cell for a restated figure. I need to record the value previously recorded in the cell as an audit trail but it is important this stores every iteration (as shown in your example above). Please may you show me how to edit the script to occur across a range of date (eg. F10:F29, G10:G29, H10:H29... etc). OR... it would be even better if I could use the range as a named workbook - one worksheet includes multiple named and referenced workbooks for my vlookups and indirect formulas. It would also be great if the output was a list of numbers in one cell rather than separate cells down the column (this is not a requirement though)

I read your article "How To Remember Or Save Previous Cell Value Of A Changed Cell In Excel?" which is great, but this does not record every change.

Thanks,
This comment was minimized by the moderator on the site
Hi Saskia,
The following code can help solving your problem.
1) The number 6 in this line "Set xDCell = Cells(xCell.Row, 6)" stands for the sixth column "column F" in the worksheet, where you want to record the previous values. You can change this number 6 to any column number as you need.
2) After adding the VBA code, please go to the Tools tab, click References, and then enable the Microsoft Scripting Runtime box in the References - VBAProject dialog box.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/check-scripting_runtime.png
3) Every change will be recorded in one cell.
https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/previous-record.png
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)
'Updated by Extendoffice 20221505
    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, 6)
        If (xDCell.Value = "") Then
            xDCell.Value = xDic.Items(I)
        Else
            xDCell.Value = xDCell.Value & "," & xDic.Items(I)
        End If
        
    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
    Dim st As String
    On Error GoTo Label1
    xDic.RemoveAll
    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
    
    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
This comment was minimized by the moderator on the site
This is great! The output into one cell in a list format is exactly what I was hoping for, thank you.

One last question please, is there a way to modify this to look at a table of values instead of a single column (in your example"C:C"). For example, I need to apply the code across several tables: F11:U25, F33:U47... etc. I previously used this script which searches multiple cells for changes that would output onto another tab (I no longer need this, but the output you have provided above):



Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

' The variable KeyCells contains the cells that will
' cause an alert when they are changed.
Set KeyCells = Range("F11:U25")

If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then

a = Sheets("Sheet3").Cells(Rows.Count, "A").End(xlUp).Column + 1
ActiveCell.Offset(0, 1).Select
Sheets("Sheet3").Range("A" & a).Value = ActiveCell.Value
ActiveCell.Offset(0, 1).Select
End If
End Sub



Is it possible to combine this with yours?

Thanks, Saskia
This comment was minimized by the moderator on the site
Hi Saskia,
If multiple cells in a table are modified, how do you want to output the previous data? For clarity, please attach a sample file or a screenshot with your data and desired results.
This comment was minimized by the moderator on the site
Merhaba;
Nasılsınız kusura bakmayın derdimi tam olarak anlatamadım özür dilerim.
Aşağıda VBA kodunu beraber yapmıştık. Bu kot olumlu olarak çalışıyor. sadece bunu aynı Excel sayfasında birden fazla kullanmak istiyorum ama nasıl yapacağımı beceremiyorum .
Öncelikle bana cevap verdiğiniz için çok minnettarım tekrardan teşekkürler.
Aslında basit bir sac açılım hesaplamaları içeren bir Excel tablosu hazırlamaya çalışıyorum.
ekteki Excel den görebilirsiniz.
mavi renkli hücreler değişen hücreler ve onların sonuçlarına göre kırmızı hücreler çıkıyor .
bu kırmızı hücrelerdeki sonuçlar panel saç açılımı sonuçları oluyor ben bunları D,F,H,J Hücrelerinde her değişimde alt alta gelecek şekilde ayarlamaya çalışıyorum. her sonuç değiştiğinde (yaptığımız worksheet işe yarıyor ama tek tek sayfa yapmak lazım ama sadece ben kullanmayacağım için tek sayfada aynı işlemleri yapmak çok işimize yarayacak )
Beklide çok daha kolay ve sabit bir çözüm vardır ama ben çözemedim siz çözebilirseniz çok sevinirim .
ekteki Excel de size gönderdiğim worksheet ile sizin yaptığınız kod (aşağıdaki) çalışması yapılmış

Dim xVal As String
'Update by Extendoffice 2022/9/30
Private Sub Worksheet_Change(ByVal Target As Range)
' Static xCount As Integer
Application.EnableEvents = False

xCount = WorksheetFunction.CountA(Range("D:D"))
If Target.Address = Range("C2").Address Then
Range("D2").Offset(xCount, 0).Value = xVal
Else
If xVal <> Range("C2").Value Then
Range("D2").Offset(xCount, 0).Value = xVal
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xVal = Range("C2").Value
End Sub
This comment was minimized by the moderator on the site
Tekrardan merhaba nasılsınız .
sizden bir yardım daha isteyebilir miyim
yukarda yazdığımız vba kodunu aynı Excel sayfasında 1 den fazla kullanmak istiyorum . Sadece hücrelerini değiştirerek nasıl yaparım her yolu denedim ama beceremedim
yardımcı olursanız sevinirim .
Kolay Gelsin
This comment was minimized by the moderator on the site
Hi Erdal Matpay,
The VBA codes in the following article may do you a favor. Please give it a try.
How To Remember Or Save Previous Cell Value Of A Changed Cell In Excel?
This comment was minimized by the moderator on the site
Hi

Thanks for your answer
I tried today and the result is positive

Regards Best
This comment was minimized by the moderator on the site
merhabalar öncelikle yaptığınız çalışma çok iyi ve emeğinize sağlık.
sizden şöyle bir şey rica edebilir miyim
D2 hücrelerinde çıkan sonuçlar alt alta yazılıyor ama ben D2 hücresinde çıkan bazı sonuçlar yanlış olduğu zaman siliyorum . Ama sildiğim yerden değil de 1 sonraki hücreden devam ediyor. yada komple D2 hücresini sildiğimde baştan değil de kaldığı hücreden devam ediyor . Bunu nasıl çözerim sizin bir fikriniz var mı yardımcı olursanız sevinirim .
Kolay Gelsin
This comment was minimized by the moderator on the site
Hi Erdal matpay,
Sorry I misunderstood you in the first reply. The following code can help.
After removing some records, new records will start from the cells you cleared. Please give it a try.

Dim xVal As String
'Update by Extendoffice 2022/9/30
Private Sub Worksheet_Change(ByVal Target As Range)
'    Static xCount As Integer
    Application.EnableEvents = False
    
    xCount = WorksheetFunction.CountA(Range("D:D"))
    If Target.Address = Range("C2").Address Then
        Range("D2").Offset(xCount, 0).Value = xVal
    Else
        If xVal <> Range("C2").Value Then
         Range("D2").Offset(xCount, 0).Value = xVal
        End If
    End If
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    xVal = Range("C2").Value
End Sub
This comment was minimized by the moderator on the site
Hi Erdal matpay,
The following VBA code can acheive: when clearing the value in C2, all the records you made before are also cleared together, and the new records will start from cell D2 again. Please give it a try.

Dim xVal As String
'Update by Extendoffice 2022/9/30
Private Sub Worksheet_Change(ByVal Target As Range)
    Static xCount As Integer
    On Error Resume Next
    Application.EnableEvents = False

    If Target.Address = Range("C2").Address Then
        If Range("C2").Value = "" Then
            Range("D2").Resize(xCount, 1).Clear
            xCount = 0
            xVal = ""
            Application.EnableEvents = True
        Exit Sub
    End If
        If xVal <> "" Then
            Range("D2").Offset(xCount, 0).Value = xVal
            xCount = xCount + 1
        End If
    Else
        If xVal <> Range("C2").Value Then
            Range("D2").Offset(xCount, 0).Value = xVal
            xCount = xCount + 1
        End If
    End If
    Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    xVal = Range("C2").Value
End Sub
This comment was minimized by the moderator on the site
merhabalar öncelikle yaptığınız çalışma çok iyi ve emeğinize sağlık.
sizden şöyle bir şey rica edebilir miyim
D2 hücrelerinde çıkan sonuçlar alt alta yazılıyor ama ben D2 hücresinde çıkan bazı sonuçlar yanlış olduğu zaman siliyorum . Ama sildiğim yerden değil de 1 sonraki hücreden devam ediyor. yada komple D2 hücresini sildiğimde baştan değil de kaldığı hücreden devam ediyor . Bunu nasıl çözerim sizin bir fikriniz var mı yardımcı olursanız sevinirim .
Kolay Gelsin
This comment was minimized by the moderator on the site
Hello , I try to use this code to download changing data from web (there is a existing excel sheet to collect data from web automatically ), but , it doesn't work to record data change history record . Any reason about that ?
This comment was minimized by the moderator on the site
Hi, Thanks for the below. Quick question....are you able to reset this at times so that on your request, you can get the macro to delete all previous numbers and start recording numbers again from cell D2? At the moment, numbers are recorded D2, D3, D4, D5, D6 etc
This comment was minimized by the moderator on the site
Hello! I tried using this code to record every change in the value of a particular cell. However, I was wondering if anyone could help me by modifying it so the change in value is collected in a DIFFERENT tab and also so it is saved every time the workbook is closed. Since it sort of re-sets itself each time the workbook is opened without saving the previous values. Code: Dim xVal As String
'Update by Extendoffice 2018/8/22
Private Sub Worksheet_Change(ByVal Target As Range)
Static xCount As Integer
Application.EnableEvents = False
If Target.Address = Range("J7").Address Then
Range("AB2").Offset(xCount, 0).Value = xVal
xCount = xCount + 1
Else
If xVal <> Range("J7").Value Then
Range("AB2").Offset(xCount, 0).Value = xVal
xCount = xCount + 1
End If
End If
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
xVal = Range("J7").Value
End Sub
This comment was minimized by the moderator on the site
Can this be changed to work for multiple cells in one worksheet?
This comment was minimized by the moderator on the site
Hi,

Please try the method in this article:

How to remember or save previous cell value of a changed cell in Excel?

https://www.extendoffice.com/documents/excel/5056-excel-remember-save-previous-cell-value.html
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations