跳到主要内容

如何在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

:在代码中,C2是要记录其所有更改值的单元格。 D2是您将填充C2的第一个变化值的单元格。

3。 按 其他 + Q 关闭键 Microsoft Visual Basic应用程序 窗口。

从现在开始,每次更改单元格C2中的值时,以前的更改值将记录在D2和D2以下的单元格中。

最佳办公生产力工具

🤖 Kutools 人工智能助手:基于以下内容彻底改变数据分析: 智能执行   |  生成代码  |  创建自定义公式  |  分析数据并生成图表  |  调用 Kutools 函数...
热门特色: 查找、突出显示或识别重复项   |  删除空白行   |  合并列或单元格而不丢失数据   |   不使用公式进行四舍五入 ...
超级查询: 多条件VLookup    多值VLookup  |   跨多个工作表的 VLookup   |   模糊查询 ....
高级下拉列表: 快速创建下拉列表   |  依赖下拉列表   |  多选下拉列表 ....
列管理器: 添加特定数量的列  |  移动列  |  切换隐藏列的可见性状态  |  比较范围和列 ...
特色功能: 网格焦点   |  设计图   |   大方程式酒吧    工作簿和工作表管理器   |  资源库 (自动文本)   |  日期选择器   |  合并工作表   |  加密/解密单元格    按列表发送电子邮件   |  超级筛选   |   特殊过滤器 (过滤粗体/斜体/删除线...)...
前 15 个工具集12 文本 工具 (添加文本, 删除字符,...)   |   50+ 图表 类型 (甘特图,...)   |   40+ 实用 公式 (根据生日计算年龄,...)   |   19 插入 工具 (插入二维码, 从路径插入图片,...)   |   12 转化 工具 (小写金额转大写, 货币兑换,...)   |   7 合并与拆分 工具 (高级组合行, 分裂细胞,...)   |   ... 和更多

使用 Kutools for Excel 增强您的 Excel 技能,体验前所未有的效率。 Kutools for Excel 提供了 300 多种高级功能来提高生产力并节省时间。  单击此处获取您最需要的功能...

产品描述


Office Tab 为 Office 带来选项卡式界面,让您的工作更加轻松

  • 在Word,Excel,PowerPoint中启用选项卡式编辑和阅读,发布者,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