跳到主要内容

如何计算Excel中单元格更改的次数？

要计算 Excel 中指定单元格的更改次数，本文提供的 VBA 代码可以提供帮助。

计算使用 VBA 代码更改单元格的次数

计算使用 VBA 代码更改单元格的次数

以下 VBA 代码可以帮助您计算指定单元格在 Excel 中更改的次数。

1. 在包含一个或多个需要计算总变化的单元格的工作表中，右键单击工作表选项卡，然后单击 查看代码 从上下文菜单中。 看截图：

2.在开幕 Microsoft Visual Basic应用程序 窗口中，将以下 VBA 代码之一复制并粘贴到 代码 窗口根据您的需要。

VBA 代码 1：仅跟踪对一个单元格的更改

Dim xCount As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If Target = Range("B9") Then
        xCount = xCount + 1
        Range("C9").Value = xCount                                     
    End If
    Application.EnableEvents = False
    Set xRg = Application.Intersect(Target.Dependents, Me.Range("B9"))
    If Not xRg Is Nothing Then
        xCount = xCount + 1
        Range("C9").Value = xCount
    End If
    Application.EnableEvents = True
End Sub

备注：在代码中，B9是您需要计数其更改的单元格，而C9是用于填充计数结果的单元格。 请根据需要更改它们。

VBA 代码 2：跟踪对列中多个单元格的更改

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub

备注：在这一行“设置 xRRg = xCell.Offset(0, 1)“， 号码 1 表示要偏移到起始引用右侧的列数（这里起始引用是 column B，并且您要返回的计数在列中 C 它位于 B 列旁边）。 如果需要在列中输出结果 S, 改变号码 1 至 10.

从现在开始，当单元格 B9 或 B9:B1000 范围内的任何单元格发生变化时，变化的总数将被叠加并自动填充到指定的单元格中。

最佳办公生产力工具

🤖 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 (26)
No ratings yet. Be the first to rate!
Graham
Graham
This comment was minimized by the moderator on the site
Hi, is there a way to apply this across multiple ranges?

I want to monitor say Column B changes offset into C (as this code does) but then also Monitor Column D changes offset into E
Reply
0
0
crystal
crystal     Graham
This comment was minimized by the moderator on the site
Hi Graham,

The following VBA code can do you a favor. Please give it a try.
Note: You can change the ranges in the code to suityour own data range.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Updated by Extendoffice 20240119
    Dim xSRgB As Range
    Dim xSRgD As Range
    Dim xCell As Range
    Dim xRRg As Range
    
    ' Define the source ranges for columns B and D
    Set xSRgB = Range("B9:B1000")
    Set xSRgD = Range("D9:D1000")

    ' Check if the changed cell is in either of the defined ranges
    Set xCell = Nothing
    If Not Intersect(xSRgB, Target) Is Nothing Then
        Set xCell = Intersect(xSRgB, Target)
        Set xRRg = xCell.Offset(0, 1) ' Offset to column C
    ElseIf Not Intersect(xSRgD, Target) Is Nothing Then
        Set xCell = Intersect(xSRgD, Target)
        Set xRRg = xCell.Offset(0, 1) ' Offset to column E
    End If

    If xCell Is Nothing Then Exit Sub

    Application.EnableEvents = False
    On Error Resume Next
    
    ' Update the adjacent cell with the change count
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
    On Error GoTo 0
End Sub
Reply
Report
0
0
Jaydee
Jaydee
This comment was minimized by the moderator on the site
Hi Crystal,

the below code does not work if a cell is dynamically being updated by another VBScript. I have a cell that is being populated by a VBScript and wanted to count the number of times the cell is updating but your code is not capturing the change.

Dim xCount As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
On Error Resume Next
If Target = Range("B9") Then
xCount = xCount + 1
Range("C9").Value = xCount
End If
Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("B9"))
If Not xRg Is Nothing Then
xCount = xCount + 1
Range("C9").Value = xCount
End If
Application.EnableEvents = True
End Sub

here is my code:
Sub Button11_Click()

Worksheets("C4L1").Range("A2:R35").Calculate
With Worksheets("C4L1")
Range("M2").Calculate
Range("N2").Calculate
Range("O2").Calculate
Range("P2").Calculate
Range("Q2").Calculate
Range("R2").Calculate
End With

End Sub

Thanks
Vgee
Reply
Report
0
0
crystal
crystal     Jaydee
This comment was minimized by the moderator on the site
Hi Vgee,

I can't get the Excel Worksheet_Change event capture the changes caused by another VBScript. Sorry for the inconvenience.
Reply
Report
0
0
wagner cesar
wagner cesar
This comment was minimized by the moderator on the site
Olá Cristal,

vi que você tem ajudado o pessoal com código vba. será q vc poderia me dar uma ajuda tb?

eu tenho uma coluna B e C onde eu preencho cada uma delas diariamente... o que eu gostaria de saber é quantas vezes eu mudo o campo B2 até mudar o campo C2 e manter esse valor de alterações no campo D2

exemplo: eu alterei o campo B2 5 vezes seguidas ate alterar o C2

D2 = 5

e quantas vezes eu alterei o campo C2 até voltar a alterar B2
exemplo: alterei o campo C2 2 vezes seguidas e voltei a alterar o campo B2
E2 = 2

e eu gostaria de manter o valor máximo dessa sequência, só voltando a alterar o campo D2 e E2 se a sequencia de alterações em B2 e C2 fossem maior do que 5 e 2, como no exemplo que eu dei.

espero que tenha ficado claro os exemplos. ahahhah... abraços
Reply
0
0
crystal
crystal     wagner cesar
This comment was minimized by the moderator on the site
Hi wagner cesar,
The following VBA code may help. Please give it a try. Thank you.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    On Error Resume Next
    
    Set xSRg = Range("B2:B10")
    Set xCell = Intersect(xSRg, Target)
    If Not xCell Is Nothing Then
        Application.EnableEvents = False
        Set xCell = xCell.Range("A1")
        Set xRRg = xCell.Offset(0, 2)
        xRRg.Value = xRRg.Value + 1
        If xRRg.Value > 5 Then
            xRRg.Value = 1
        End If
        Application.EnableEvents = True
    End If
    
    Set xSRg = Range("C2:C10")
    Set xCell = Intersect(xSRg, Target)
    If Not xCell Is Nothing Then
        Application.EnableEvents = False
        Set xCell = xCell.Range("A1")
        Set xRRg = xCell.Offset(0, 2)
        xRRg.Value = xRRg.Value + 1
        If xRRg.Value > 2 Then
            xRRg.Value = 1
        End If
        Application.EnableEvents = True
    End If
        
End Sub
Reply
Report
0
0
Julian
Julian
This comment was minimized by the moderator on the site
Thanks Crystal, works great!
Reply
0
0
I try
I try
This comment was minimized by the moderator on the site
I try the code below and it works, but I'm using it to track changes on dates, since some dates are the same everytime I change a date that is the same to other on the colum it count again.
I try the latest code but it does nothing when I try it. THANKS FOR THIS GREAT CODE!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("I3:I1000")
Set xRRg = Range("S3:S1000")

Application.EnableEvents = False
On Error Resume Next
For xFNum = 1 To xSRg.Count
If Target = xSRg.Item(xFNum) Then
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Next xFNum
Application.EnableEvents = True
End Sub
Sub CleaRCount()
'Updated by Extendoffice 20220527
xCount = 0
Range("S3") = 0
End Sub
Reply
0
0
crystal
crystal     I try
This comment was minimized by the moderator on the site
Hi,
The following VBA code can do you a favor. Please give it a try.
Note: In this line "Set xRRg = xCell.Offset(0, 10)", the number "10” represents the number of columns to offset to the right of the starting reference (here the starting reference is column I, and the count you want to return is in column S).

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220919
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("I3:I1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 10)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub
Reply
Report
0
0
Gadjus
Gadjus
This comment was minimized by the moderator on the site
Hi Crystal

I am having the same issue as RedDragon. I am trying to track date changes, for example when an agent sends a case to their manager they manually enter a date- this can happen more than once On a case so I am trying to use this code to show how many times each case has been sent to a manager. My issues are:

1) If multiple cases are sent to managers in one day, the counter increases only on the first instance of that date, not next to the rows in question.
2) Every time I exit the sheet, reopen it, and amend a date, the counter resets to "1"- how would I get this to carry over and not reset when the sheet is reopened?

Any help is greatly appreciated and thank you so much for what you have done so far.

Gadjus
Reply
0
0
crystal
crystal     Gadjus
This comment was minimized by the moderator on the site
Hi Gadjus,
Sorry for the inconvinience. The following VBA code can do you a favor. Please give it a try.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub
Reply
Report
0
0
FMARINO
FMARINO
This comment was minimized by the moderator on the site
Quisiera que me ayudaran a reiniciar el contador a cero cuando lo requiera, es decir, la celda c9 llevarla a cero y comenzar a contar b9 nuevamente.
Reply
Report
0
0
crystal
crystal     FMARINO
This comment was minimized by the moderator on the site
Hi FELIX MARIÑO,
Please add the following code after the code provided in this post. When you need to reset the cell, click on any words in the code, and then press the F5 key to run it.
Sub CleaRCount()
'Updated by Extendoffice 20220527
    xCount = 0
    Range("c9") = 0
End Sub
Reply
Report
0
0
Mason
Mason
This comment was minimized by the moderator on the site
Can anyone help me achieve the coding for Counting the time a cell has been changed to "Revalidate" and can that be applied down the entrieity of a column.
Reply
0
0
JediTrader
JediTrader
This comment was minimized by the moderator on the site
Team,

When I tried using :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("B9:B1000")
Set xRRg = Range("C9:C1000")

carefully changing the Range and Target cells vis a vis P2:P200 and X2:X200 respectively, I dont the change-count in X Column despite myself trying to change cells across multiple rows across P2:P200.

Any help would be greatly appreciated.

Regards
JT
Reply
Report
0
0
cherias
cherias
This comment was minimized by the moderator on the site
Hello All,

The solution as provided under "Count Number Of Times A Cell Is Changed With VBA Code" is good if we are only tracking changes to ONE CELL. Please suggest, what modifications are needed, if the tracking is to be done for multiple cells. In case of multiple cells, the incremental counter should appear next to the cell for which the change in value is being tracked.
Reply
Report
0
0
Shiju
Shiju     cherias
This comment was minimized by the moderator on the site
Looking forward for help and assistance to have a specific VBA code, which can be applied to multiple cells in one worksheet.
Reply
0
0
crystal
crystal     Shiju
This comment was minimized by the moderator on the site
Hi Shiju,
Please try the below VBA code. Thanks for commenting.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("B9:B1000")
Set xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
For xFNum = 1 To xSRg.count
If Target = xSRg.Item(xFNum) Then
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Next xFNum
Application.EnableEvents = True
End Sub
Reply
Report
0
0
There are no comments posted here yet
Load More
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations