Loncat ke daftar isi utama

Bagaimana menghitung berapa kali sel diubah di Excel?

Untuk menghitung berapa kali sel tertentu diubah di Excel, kode VBA yang disediakan dalam artikel ini dapat membantu.

Hitung berapa kali sel diubah dengan kode VBA

Hitung berapa kali sel diubah dengan kode VBA

Kode VBA berikut dapat membantu Anda menghitung berapa kali sel tertentu diubah di Excel.

1. Di lembar kerja yang berisi satu atau beberapa sel yang perlu Anda hitung total perubahannya, klik kanan tab lembar, lalu klik Lihat kode dari menu konteks. Lihat tangkapan layar:

2. Dalam pembukaan Microsoft Visual Basic untuk Aplikasi jendela, salin dan tempel salah satu kode VBA berikut ke dalam Kode jendela sesuai dengan kebutuhan Anda.

Kode VBA 1: Lacak perubahan ke satu sel saja

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

Note: Dalam kode, B9 adalah sel yang Anda butuhkan untuk menghitung perubahannya, dan C9 adalah sel untuk mengisi hasil penghitungan. Harap ubah sesuai kebutuhan Anda.

Kode VBA 2: Lacak perubahan ke beberapa sel dalam satu kolom

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

Note: Di baris ini "Tetapkan xRRg = xCell.Offset(0, 1)", nomor 1 mewakili jumlah kolom untuk diimbangi di sebelah kanan referensi awal (di sini referensi awal adalah kolom B, dan jumlah yang ingin Anda kembalikan ada di kolom C yang terletak di sebelah kolom B). Jika Anda perlu menampilkan hasilnya di kolom S, ganti nomor 1 untuk 10.

Mulai sekarang, ketika sel B9 atau sel mana pun dalam rentang B9:B1000 berubah, jumlah total perubahan akan ditumpangkan dan secara otomatis diisi ke dalam sel yang ditentukan.

Alat Produktivitas Kantor Terbaik

Fitur Populer: Temukan, Sorot, atau Identifikasi Duplikat   |  Hapus Baris Kosong   |  Gabungkan Kolom atau Sel tanpa Kehilangan Data   |   Putaran tanpa Formula ...
Pencarian Super: VLookup Beberapa Kriteria  |   VLookup Nilai Berganda  |   VLookup di Beberapa Lembar   |   Pencarian Fuzzy ....
Daftar Drop-down Lanjutan: Buat Daftar Drop Down dengan Cepat   |  Daftar Drop Down yang Bergantung   |  Multi-pilih Drop Down List ....
Manajer Kolom: Tambahkan Jumlah Kolom Tertentu  |  Pindahkan Kolom  |  Alihkan Status Visibilitas Kolom Tersembunyi  |  Bandingkan Rentang & Kolom ...
Fitur Unggulan: Fokus Kisi   |  Tampilan Desain   |   Bar Formula Besar   |  Manajer Buku Kerja & Lembar   |  Perpustakaan Sumberdaya (Teks otomatis)   |  Pemetik tanggal   |  Gabungkan Lembar Kerja   |  Enkripsi/Dekripsi Sel   |  Kirim Email berdasarkan Daftar   |  Filter Super   |   Filter Khusus (filter tebal/miring/coret...) ...
15 Perangkat Teratas:  12 Teks Tools (Tambahkan Teks, Hapus Karakter, ...)   |   50 + Grafik jenis (Gantt Chart, ...)   |   40+ Praktis Rumus (Hitung usia berdasarkan ulang tahun, ...)   |   19 Insersi Tools (Masukkan Kode QR, Sisipkan Gambar dari Jalur, ...)   |   12 Konversi Tools (Angka ke Kata, Konversi Mata Uang, ...)   |   7 Gabungkan & Pisahkan Tools (Lanjutan Gabungkan Baris, Pisahkan Sel, ...)   |   ... dan banyak lagi

Tingkatkan Keterampilan Excel Anda dengan Kutools for Excel, dan Rasakan Efisiensi yang Belum Pernah Ada Sebelumnya. Kutools for Excel Menawarkan Lebih dari 300 Fitur Canggih untuk Meningkatkan Produktivitas dan Menghemat Waktu.  Klik Di Sini untuk Mendapatkan Fitur yang Paling Anda Butuhkan...

tab kte 201905

Office Tab Menghadirkan antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Lebih Mudah

  • Aktifkan pengeditan dan pembacaan tab di Word, Excel, PowerPoint, Publisher, Access, Visio, dan Project.
  • Buka dan buat banyak dokumen di tab baru di jendela yang sama, bukan di jendela baru.
  • Meningkatkan produktivitas Anda sebesar 50%, dan mengurangi ratusan klik mouse untuk Anda setiap hari!
Comments (24)
No ratings yet. Be the first to rate!
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
lewiskj
lewiskj
This comment was minimized by the moderator on the site
Did you figure this out. I too am interested in this for checking multiple cells. Haven’t tried it yet.
Reply
Report
0
0
crystal
crystal     lewiskj
This comment was minimized by the moderator on the site
Hi Kevin,

The following code can help you solving the problem. Thanks for your comment.
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
FMARINO
FMARINO     crystal
This comment was minimized by the moderator on the site
Gracias de antemano por el aporte, muy útil, sin embargo, quisiera pedir su ayuda a fin de reiniciar el contador a cero cuando sea necesario, es decir, luego de contar las veces que se modificó la celda, quisiera llevarla a cero y volver a comenzar. podrás ayudarme. Gracias!
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