Перейти до основного матеріалу

Як записати змінні значення в комірці в Excel?

Як записати кожне мінливе значення для часто мінливої ​​комірки в Excel? Наприклад, оригінальне значення в комірці C2 дорівнює 100, при зміні числа 100 на 200 оригінальне значення 100 автоматично відображатиметься в комірці D2 для запису. Вперед, змініть 200 на 300, число 200 буде вставлено в комірку D3, зміна 300 на 400 відобразить 300 на D4 і так далі. Метод у цій статті може допомогти вам його досягти.

Запис змінних значень у комірку з кодом VBA


Запис змінних значень у комірку з кодом VBA

Наведений нижче код VBA може допомогти вам записати кожне змінне значення в комірці в Excel. Будь ласка, виконайте наступне.

1. На робочому аркуші міститься клітинка, яку потрібно записати, змінюючи значення, клацніть правою кнопкою миші вкладку аркуша, а потім клацніть Переглянути код з контекстного меню. Дивіться знімок екрана:

2. Тоді Microsoft Visual Basic для додатків відкривається вікно, скопіюйте нижче код VBA у вікно коду.

Код 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

примітки: У коді С2 - це клітинка, в яку ви хочете записати всі її змінні значення. D2 - це клітинка, яку ви заповните першим змінним значенням C2.

3 Натисніть кнопку інший + Q клавіші, щоб закрити Microsoft Visual Basic для додатків вікна.

Відтепер щоразу, коли ви змінюєте значення в комірці C2, попередні мінливі значення записуватимуться в D2, а клітинки нижче D2.

Найкращі інструменти продуктивності офісу

Популярні функції: Знайдіть, виділіть або визначте дублікати   |  Видалити порожні рядки   |  Об’єднайте стовпці або клітинки без втрати даних   |   Раунд без Формули ...
Супер пошук: VLookup за кількома критеріями    Багатозначний VLookup  |   VLookup на кількох аркушах   |   Нечіткий пошук ....
Розширений розкривний список: Швидке створення випадаючого списку   |  Залежний спадний список   |  Виберіть розкривний список, що вибирається ....
Менеджер колонок: Додайте конкретну кількість стовпців  |  Перемістити стовпці  |  Перемкнути статус видимості прихованих стовпців  |  Порівняйте діапазони та стовпці ...
Особливості: Фокус сітки   |  Перегляд дизайну   |   Велика панель формул    Диспетчер робочих книг і аркушів   |  Бібліотека ресурсів (автотекст)   |  Вибір дати   |  Об’єднайте робочі аркуші   |  Шифрування/розшифрування клітинок    Надсилайте листи за списком   |  Супер фільтр   |   Спеціальний фільтр (фільтр жирний/курсив/закреслений...) ...
Топ-15 наборів інструментів12 текст Tools (додати текст, Видалити символи, ...)   |   50 + Графік типи (діаграма Ганта, ...)   |   40+ Практичний Формули (Розрахуйте вік на основі дня народження, ...)   |   19 вставка Tools (Вставте QR-код, Вставити зображення зі шляху, ...)   |   12 Перетворення Tools (Числа до слів, Валютна конверсія, ...)   |   7 Злиття та розділення Tools (Розширені комбіновані ряди, Розділені клітини, ...)   |   ... і більше

Покращуйте свої навички Excel за допомогою Kutools для Excel і відчуйте ефективність, як ніколи раніше. Kutools для Excel пропонує понад 300 додаткових функцій для підвищення продуктивності та економії часу.  Натисніть тут, щоб отримати функцію, яка вам найбільше потрібна...

вкладка kte 201905


Вкладка Office Передає інтерфейс із вкладками в Office і значно полегшує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 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