Ga naar hoofdinhoud

Hoe tel je het aantal keren dat een cel in Excel wordt gewijzigd?

Om het aantal keren te tellen dat een opgegeven cel in Excel is gewijzigd, kunnen de VBA-codes in dit artikel helpen.

Tel het aantal keren dat een cel is gewijzigd met VBA-code

Tel het aantal keren dat een cel is gewijzigd met VBA-code

De volgende VBA-codes kunnen u helpen bij het tellen van het aantal keren dat een opgegeven cel in Excel is gewijzigd.

1. In een werkblad dat een of meer cellen bevat waarvoor u de totale wijziging moet berekenen, klikt u met de rechtermuisknop op de bladtab en klikt u vervolgens op Bekijk code vanuit het contextmenu. Zie screenshot:

2. In de opening Microsoft Visual Basic voor toepassingen venster, kopieer en plak een van de volgende VBA-codes in de Code raam volgens uw behoeften.

VBA-code 1: Houd wijzigingen in slechts één cel bij

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: In de code is B9 de cel die u nodig hebt om de wijzigingen te tellen, en C9 is de cel om het telresultaat te vullen. Wijzig ze indien nodig.

VBA-code 2: Wijzigingen in meerdere cellen in een kolom bijhouden

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: In deze regel "Stel xRRg = xCell.Offset(0, 1) in", het nummer 1 vertegenwoordigt het aantal kolommen dat moet worden verschoven naar rechts van de startreferentie (hier is de startreferentie kolom) B, en de telling die u wilt retourneren staat in kolom C die zich naast kolom B bevindt). Als u de resultaten in de kolom moet uitvoeren: S, verander het nummer 1 naar 10.

Vanaf nu, wanneer cel B9 of een cel in het bereik B9:B1000 verandert, wordt het totale aantal wijzigingen gesuperponeerd en automatisch ingevuld in de opgegeven cel.

Beste Office-productiviteitstools

🤖 Kutools AI-assistent: Een revolutie teweegbrengen in de data-analyse op basis van: Intelligente uitvoering   |  Genereer code  |  Aangepaste formules maken  |  Analyseer gegevens en genereer grafieken  |  Roep Kutools-functies aan...
Populaire functies: Zoek, markeer of identificeer duplicaten   |  Verwijder lege rijen   |  Combineer kolommen of cellen zonder gegevens te verliezen   |   Ronde zonder formule ...
Super opzoeken: Meerdere criteria VLookup  |   VLookup met meerdere waarden  |   VOpzoeken over meerdere bladen   |   Fuzzy opzoeken ....
Geavanceerde vervolgkeuzelijst: Maak snel een vervolgkeuzelijst   |  Afhankelijke vervolgkeuzelijst   |  Multi-select vervolgkeuzelijst ....
Kolom Beheerder: Voeg een specifiek aantal kolommen toe  |  Kolommen verplaatsen  |  Schakel de zichtbaarheidsstatus van verborgen kolommen in  |  Vergelijk bereiken en kolommen ...
Uitgelichte functies: Raster focus   |  Ontwerpweergave   |   Grote formulebalk   |  Werkmap- en bladbeheer   |  resource Library (Auto-tekst)   |  Datumkiezer   |  Combineer werkbladen   |  Cellen coderen/decoderen   |  Stuur e-mails per lijst   |  Super filter   |   Speciaal filter (filter vet/cursief/doorhalen...) ...
Top 15 gereedschapsets:  12 Tekst Tools (toe te voegen tekst, Tekens verwijderen, ...)   |   50+ tabel Types (Gantt Chart, ...)   |   40+ Praktisch Formules (Bereken leeftijd op basis van verjaardag, ...)   |   19 Invoeging Tools (QR-code invoegen, Afbeelding invoegen vanaf pad, ...)   |   12 Camper ombouw Tools (Getallen naar woorden, Currency Conversion, ...)   |   7 Samenvoegen en splitsen Tools (Geavanceerd Combineer rijen, Gespleten cellen, ...)   |   ... en meer

Geef uw Excel-vaardigheden een boost met Kutools voor Excel en ervaar efficiëntie als nooit tevoren. Kutools voor Excel biedt meer dan 300 geavanceerde functies om de productiviteit te verhogen en tijd te besparen.  Klik hier om de functie te krijgen die u het meest nodig heeft...

Omschrijving

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert honderden muisklikken voor u elke dag!
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