Bỏ qua nội dung chính

Làm cách nào để đếm số lần một ô được thay đổi trong Excel?

Để đếm số lần một ô đã chỉ định được thay đổi trong Excel, mã VBA được cung cấp trong bài viết này có thể giúp ích.

Đếm số lần một ô được thay đổi bằng mã VBA

Đếm số lần một ô được thay đổi bằng mã VBA

Các mã VBA sau đây có thể giúp bạn đếm số lần một ô đã chỉ định được thay đổi trong Excel.

1. Trong trang tính có chứa một hoặc nhiều ô mà bạn cần tính tổng thay đổi, hãy bấm chuột phải vào tab trang tính, sau đó bấm Mã Chế độ xem từ menu ngữ cảnh. Xem ảnh chụp màn hình:

2. Trong phần mở đầu Microsoft Visual Basic cho các ứng dụng cửa sổ, sao chép và dán một trong các mã VBA sau vào Mã cửa sổ theo nhu cầu của bạn.

Mã VBA 1: Chỉ theo dõi các thay đổi đối với một ô

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

Chú thích: Trong mã, B9 là ô bạn cần đếm các thay đổi của nó và C9 là ô để điền kết quả đếm. Vui lòng thay đổi chúng khi bạn cần.

Mã VBA 2: Theo dõi các thay đổi đối với nhiều ô trong một cột

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

Chú thích: Trong dòng này "Đặt xRRg = xCell.Offset (0, 1)", con số 1 đại diện cho số cột cần bù đắp ở bên phải của tham chiếu bắt đầu (ở đây tham chiếu bắt đầu là cột Bvà số lượng bạn muốn trả lại nằm trong cột C nằm bên cạnh cột B). Nếu bạn cần xuất kết quả trong cột S, thay đổi số 1 đến 10.

Từ bây giờ, khi ô B9 hoặc bất kỳ ô nào trong phạm vi B9: B1000 thay đổi, tổng số thay đổi sẽ được chồng lên và tự động điền vào ô được chỉ định.

Công cụ năng suất văn phòng tốt nhất

🤖 Trợ lý AI của Kutools: Cách mạng hóa việc phân tích dữ liệu dựa trên: Thực thi thông minh   |  Tạo mã  |  Tạo công thức tùy chỉnh  |  Phân tích dữ liệu và tạo biểu đồ  |  Gọi các hàm Kutools...
Các tính năng phổ biến: Tìm, đánh dấu hoặc xác định các bản sao   |  Xóa hàng trống   |  Kết hợp các cột hoặc ô mà không làm mất dữ liệu   |   Vòng không có công thức hữu ích. Cảm ơn !
Siêu tra cứu: Nhiều tiêu chí VLookup  |   VLookup Nhiều Giá Trị  |   VLookup trên nhiều trang tính   |   Tra cứu mờ ....
Danh sách thả xuống nâng cao: Tạo nhanh danh sách thả xuống   |  Danh sách thả xuống phụ thuộc   |  Danh sách thả xuống nhiều lựa chọn ....
Trình quản lý cột: Thêm một số cột cụ thể  |  Di chuyển cột  |  Chuyển đổi trạng thái hiển thị của các cột ẩn  |  So sánh dãy và cột hữu ích. Cảm ơn !
Các tính năng nổi bật: Tiêu điểm lưới   |  Chế độ xem thiết kế   |   Thanh công thức lớn   |  Trình quản lý sổ làm việc & trang tính   |  Thư viện tài nguyên (Văn bản tự động)   |  Bảng chọn ngày   |  Kết hợp các bảng tính   |  Mã hóa/Giải mã ô   |  Gửi email theo danh sách   |  Siêu lọc   |   Bộ lọc đặc biệt (lọc in đậm/nghiêng/gạch ngang...) ...
15 bộ công cụ hàng đầu:  12 bản văn CÔNG CỤ (thêm văn bản, Xóa ký tự,...)   |   50 + Biểu đồ Các loại (Biểu đồ Gantt,...)   |   40+ Thực tế Công thức (Tính tuổi dựa trên ngày sinh,...)   |   19 chèn CÔNG CỤ (Chèn mã QR, Chèn ảnh từ đường dẫn,...)   |   12 Chuyển đổi CÔNG CỤ (Số thành từ, Chuyển đổi tiền tệ,...)   |   7 Hợp nhất & Tách CÔNG CỤ (Các hàng kết hợp nâng cao, Chia ô,...)   |   ... và nhiều hơn nữa

Nâng cao kỹ năng Excel của bạn với Kutools for Excel và trải nghiệm hiệu quả hơn bao giờ hết. Kutools for Excel cung cấp hơn 300 tính năng nâng cao để tăng năng suất và tiết kiệm thời gian.  Bấm vào đây để có được tính năng bạn cần nhất...

Mô tả

Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
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