Note: The other languages of the website are Google-translated. Back to English

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

Kutools for Excel Memecahkan Sebagian Besar Masalah Anda, dan Meningkatkan Produktivitas Anda dengan
80%

  • Reuse: Masukkan dengan cepat rumus, bagan yang kompleks dan apa pun yang pernah Anda gunakan sebelumnya; Enkripsi Sel dengan kata sandi; Buat Milis dan mengirim email ...
  • Bilah Formula Super (dengan mudah mengedit beberapa baris teks dan rumus); Membaca Tata Letak (membaca dan mengedit sel dalam jumlah besar dengan mudah); Tempel ke Rentang yang Difilter...
  • Gabungkan Sel / Baris / Kolom tanpa kehilangan Data; Pisahkan Konten Sel; Gabungkan Baris / Kolom Duplikat... Mencegah Sel Duplikat; Bandingkan Rentang...
  • Pilih Duplikat atau Unik Baris; Pilih Baris Kosong (semua sel kosong); Temukan Super dan Temukan Fuzzy di Banyak Buku Kerja; Pilih Acak ...
  • Salinan Tepat Beberapa Sel tanpa mengubah referensi rumus; Buat Referensi Otomatis ke Beberapa Lembar; Sisipkan Poin, Kotak Centang, dan lainnya ...
  • Ekstrak Teks, Tambahkan Teks, Hapus berdasarkan Posisi, Hapus Space; Membuat dan Mencetak Subtotal Paging; Konversi Konten Antar Sel dan Komentar...
  • Filter Super (simpan dan terapkan skema filter ke sheet lain); Penyortiran Lanjutan menurut bulan / minggu / hari, frekuensi dan lainnya; Filter Khusus dengan huruf tebal, miring ...
  • Gabungkan Workbooks dan WorkSheets; Gabungkan Tabel berdasarkan kolom kunci; Pisahkan Data menjadi Beberapa Lembar; Konversi Batch xls, xlsx dan PDF...
  • Lebih dari
    300
    fitur yang kuat
    . Mendukung Office/Excel
    2007-2019 dan 365
    . Mendukung semua bahasa. Penerapan yang mudah di perusahaan atau organisasi Anda. Fitur lengkap
    30
    percobaan gratis -hari. Jaminan uang kembali 60 hari.
tab kte 201905

Tab Office Membawa antarmuka Tab ke Office, dan Membuat Pekerjaan Anda Jauh 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 dengan
    50%
    , dan mengurangi ratusan klik mouse untuk Anda setiap hari!
officetab bawah
Urutkan komentar berdasarkan
komentar (20)
Belum ada peringkat. Jadilah yang pertama memberi peringkat!
Komentar ini diminimalkan oleh moderator di situs
Terima kasih banyak ! Ini bekerja dengan baik.

Tetapi bagaimana Anda membuat fungsi/aturan yang sama berfungsi untuk rentang sel, di sepanjang seluruh kolom, misalnya?

Saya memiliki daftar kontak bisnis saya di baris yang berbeda, dengan detail kontak mereka di kolom yang berbeda, dan saya ingin menambahkan kolom yang mendaftar dan menghitung berapa kali sel tertentu di sepanjang setiap baris diubah. Kode yang Anda berikan berfungsi dengan baik, tetapi hanya untuk satu sel pada satu waktu !

Saya baru mengenal VBA, jadi saya akan sangat menghargai dukungan Anda.

Saya mencoba menambahkan rentang sel ke dalam kode, jadi alih-alih "B9" dan "C9", seperti yang diberikan pada contoh di atas, saya bermain-main dengan variasi seperti "B:B", "C:C", atau "B9 :B1000" dan "C9:C1000", tanpa hasil.

Terima kasih sebelumnya,
Komentar ini diminimalkan oleh moderator di situs
Hai Jan,
Silakan coba kode VBA di bawah ini. Semoga bisa membantu. Terima kasih atas komentar Anda.

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redupkan xRg Sebagai Rentang, xCell Sebagai Rentang
Redupkan xSRg, xRRg Sebagai Rentang
Redupkan xFNum Selamanya

Setel xSRg = Rentang("B9:B1000")
Tetapkan xRRg = Rentang("C9:C1000")

Application.EnableEvents = Salah
On Error Resume Next
Untuk xFNum = 1 Ke xSRg.count
Jika Target = xSRg.Item(xFNum) Maka
xRRg.Item(xFNum).Nilai = xRRg.Item(xFNum).Nilai + 1
Application.EnableEvents = Benar
Keluar dari Sub
End If
xFNum berikutnya
Application.EnableEvents = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal,

Ini brilian, pada matriks saya, saya telah menggunakan ini di salah satu kolom tetapi saya telah berjuang untuk menduplikasi ini di beberapa kolom. Apakah Anda punya solusi?

Thanks in Advance
Komentar ini diminimalkan oleh moderator di situs
Bisakah Anda memberikan seluruh rangkaian kode? Saya berasumsi kode Crystal terintegrasi dengan kode lain? terima kasih
Komentar ini diminimalkan oleh moderator di situs
Hai kristal,

Saya mengalami masalah dengan kode. Jika sel misalnya, jika saya masuk

B9 sebagai "Apple" maka C9 bertambah 1
B10 sebagai "Bola" maka C10 bertambah 1
Namun, jika saya masuk
B11 sebagai "Apple" lagi maka C9 akan bertambah 1, dan bukan C11

Sepertinya itu menambah baris dengan kemunculan nilai pertama dan bukan baris yang diedit sebenarnya.

Apakah ada cara untuk hanya menambah sel di baris yang sama dan bukan baris sebelumnya?

Terima kasih.
Komentar ini diminimalkan oleh moderator di situs
Apakah Anda mengetahui hal ini. Saya juga tertarik dengan ini untuk memeriksa banyak sel. Belum mencobanya.
Komentar ini diminimalkan oleh moderator di situs
Hi Kevin,

Kode berikut dapat membantu Anda memecahkan masalah. Terima kasih atas komentar Anda.
Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redupkan xRg Sebagai Rentang, xCell Sebagai Rentang
Redupkan xSRg, xRRg Sebagai Rentang
Redupkan xFNum Selamanya

Setel xSRg = Rentang("B9:B1000")
Tetapkan xRRg = Rentang("C9:C1000")

Application.EnableEvents = Salah
On Error Resume Next
Untuk xFNum = 1 Ke xSRg.count
Jika Target = xSRg.Item(xFNum) Maka
xRRg.Item(xFNum).Nilai = xRRg.Item(xFNum).Nilai + 1
Application.EnableEvents = Benar
Keluar dari Sub
End If
xFNum berikutnya
Application.EnableEvents = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
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 volver celda, quisiera cerllevarla comenzar. podras ayudarme. Terima kasih!
Komentar ini diminimalkan oleh moderator di situs
Halo Semua,

Solusi seperti yang disediakan di bawah "Hitung Berapa Kali Sel Diubah Dengan Kode VBA" bagus jika kita hanya melacak perubahan pada SATU SEL. Mohon saran, modifikasi apa yang diperlukan, jika pelacakan harus dilakukan untuk beberapa sel. Dalam kasus beberapa sel, penghitung inkremental akan muncul di sebelah sel yang perubahan nilainya sedang dilacak.
Komentar ini diminimalkan oleh moderator di situs
Menantikan bantuan dan bantuan untuk memiliki kode VBA tertentu, yang dapat diterapkan ke banyak sel dalam satu lembar kerja.
Komentar ini diminimalkan oleh moderator di situs
Hai Shiju,
Silakan coba kode VBA di bawah ini. Terima kasih telah berkomentar.

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redupkan xRg Sebagai Rentang, xCell Sebagai Rentang
Redupkan xSRg, xRRg Sebagai Rentang
Redupkan xFNum Selamanya

Setel xSRg = Rentang("B9:B1000")
Tetapkan xRRg = Rentang("C9:C1000")

Application.EnableEvents = Salah
On Error Resume Next
Untuk xFNum = 1 Ke xSRg.count
Jika Target = xSRg.Item(xFNum) Maka
xRRg.Item(xFNum).Nilai = xRRg.Item(xFNum).Nilai + 1
Application.EnableEvents = Benar
Keluar dari Sub
End If
xFNum berikutnya
Application.EnableEvents = Benar
End Sub
Komentar ini diminimalkan oleh moderator di situs
Tim,

Ketika saya mencoba menggunakan:

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redupkan xRg Sebagai Rentang, xCell Sebagai Rentang
Redupkan xSRg, xRRg Sebagai Rentang
Redupkan xFNum Selamanya

Setel xSRg = Rentang("B9:B1000")
Tetapkan xRRg = Rentang("C9:C1000")

hati-hati mengubah Sel Rentang dan Target vis a vis P2:P200 dan X2:X200 masing-masing, saya tidak menghitung perubahan di Kolom X meskipun saya sendiri mencoba mengubah sel di beberapa baris di P2:P200.

Bantuan apa pun akan sangat dihargai.

Salam
JT
Komentar ini diminimalkan oleh moderator di situs
Adakah yang bisa membantu saya mencapai pengkodean untuk Menghitung waktu sel telah diubah menjadi "Validasi ulang" dan dapatkah itu diterapkan ke entri kolom.
Komentar ini diminimalkan oleh moderator di situs
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.
Komentar ini diminimalkan oleh moderator di situs
Hai FELIX MARIO,
Silahkan tambahkan kode berikut setelah kode yang diberikan pada postingan ini. Saat Anda perlu mengatur ulang sel, klik kata apa pun dalam kode, lalu tekan tombol F5 untuk menjalankannya.
Sub CleaRCount()
'Updated by Extendoffice 20220527
    xCount = 0
    Range("c9") = 0
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai Kristal

Saya mengalami masalah yang sama dengan RedDragon. Saya mencoba melacak perubahan tanggal, misalnya ketika agen mengirim kasus ke manajer mereka, mereka memasukkan tanggal secara manual - ini bisa terjadi lebih dari sekali Pada sebuah kasus jadi saya mencoba menggunakan kode ini untuk menunjukkan berapa kali setiap kasus memiliki telah dikirim ke manajer. Masalah saya adalah:

1) Jika beberapa kasus dikirim ke manajer dalam satu hari, penghitung meningkat hanya pada contoh pertama tanggal tersebut, tidak di sebelah baris yang bersangkutan.
2) Setiap kali saya keluar dari lembar, membukanya kembali, dan mengubah tanggal, penghitung diatur ulang ke "1" - bagaimana saya bisa membawa ini dan tidak mengatur ulang saat lembar dibuka kembali?

Bantuan apa pun sangat dihargai dan terima kasih banyak atas apa yang telah Anda lakukan sejauh ini.

Gajus
Komentar ini diminimalkan oleh moderator di situs
Hai Gajus,
Maaf atas ketidaknyamanannya. Kode VBA berikut dapat membantu Anda. Ayo cobalah.

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
Komentar ini diminimalkan oleh moderator di situs
Saya mencoba kode di bawah ini dan berhasil, tetapi saya menggunakannya untuk melacak perubahan pada tanggal, karena beberapa tanggal sama setiap kali saya mengubah tanggal yang sama dengan yang lain di kolom itu dihitung lagi.
Saya mencoba kode terbaru tetapi tidak berhasil ketika saya mencobanya. TERIMA KASIH UNTUK KODE YANG HEBAT INI!

Sub Lembar Kerja Pribadi_Rubah (Rentang Target As ByVal)
Redupkan xRg Sebagai Rentang, xCell Sebagai Rentang
Redupkan xSRg, xRRg Sebagai Rentang
Redupkan xFNum Selamanya

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

Application.EnableEvents = Salah
On Error Resume Next
Untuk xFNum = 1 Untuk xSRg.Count
Jika Target = xSRg.Item(xFNum) Maka
xRRg.Item(xFNum).Nilai = xRRg.Item(xFNum).Nilai + 1
Application.EnableEvents = Benar
Keluar dari Sub
End If
xFNum berikutnya
Application.EnableEvents = Benar
End Sub
Sub ClearRCount()
'Diperbaharui oleh Extendoffice 20220527
xJumlah = 0
Rentang("S3") = 0
End Sub
Komentar ini diminimalkan oleh moderator di situs
Hai,
Kode VBA berikut dapat membantu Anda. Ayo cobalah.
Note: Di baris ini "Tetapkan xRRg = xCell.Offset(0, 10)", nomor "10” mewakili jumlah kolom yang akan di-offset di sebelah kanan referensi awal (di sini referensi awal adalah kolom I, dan jumlah yang ingin Anda kembalikan ada di kolom 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
Komentar ini diminimalkan oleh moderator di situs
Terima kasih Crystal, bekerja dengan baik!
Belum ada komentar yang diposting di sini
Tinggalkan komentar anda
Posting sebagai Tamu
×
Beri peringkat pos ini:
0   Karakter
Lokasi yang Disarankan

Ikuti kami

Hak Cipta © 2009 - www.extendoffice.com. | Seluruh hak cipta. Dipersembahkan oleh ExtendOffice. | Peta Situs
Microsoft dan logo Office adalah merek dagang atau merek dagang terdaftar dari Microsoft Corporation di Amerika Serikat dan / atau negara lain.
Dilindungi oleh Sectigo SSL