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

Hur räknar man antalet gånger en cell ändras i Excel?

För att räkna antalet gånger en specificerad cell ändras i Excel kan VBA-koderna i den här artikeln hjälpa.

Räkna antalet gånger en cell ändras med VBA-kod


Räkna antalet gånger en cell ändras med VBA-kod

Följande VBA-koder kan hjälpa dig att räkna antalet gånger en specificerad cell ändras i Excel.

1. I ett kalkylblad som innehåller en eller flera celler för vilka du behöver beräkna den totala förändringen, högerklickar du på arkfliken och klickar sedan på Visa kod från snabbmenyn. Se skärmdump:

2. I öppningen Microsoft Visual Basic för applikationer fönster, kopiera och klistra in en av följande VBA-koder i Koda fönster efter dina behov.

VBA-kod 1: Spåra ändringar till endast en cell

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

Anmärkningar: I koden är B9 cellen du behöver för att räkna dess ändringar, och C9 är cellen för att fylla räkningsresultatet. Ändra dem efter behov.

VBA-kod 2: Spåra ändringar av flera celler i en kolumn

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

Anmärkningar: På den här raden "Ställ in xRRg = xCell.Offset(0, 1)", numret 1 representerar antalet kolumner som ska förskjutas till höger om startreferensen (här är startreferensen kolumn B, och antalet du vill returnera finns i kolumnen C som finns bredvid kolumn B). Om du behöver mata ut resultaten i kolumn S, ändra numret 1 till 10.

Från och med nu, när cell B9 eller någon cell i intervallet B9:B1000 ändras, kommer det totala antalet ändringar att läggas över och automatiskt fyllas i den angivna cellen.


De bästa Office-produktivitetsverktygen

Kutools för Excel löser de flesta av dina problem och ökar din produktivitet med 80%

  • återanvändning: Sätt snabbt i komplexa formler, diagram och allt som du har använt tidigare; Kryptera celler med lösenord; Skapa e-postlista och skicka e-post ...
  • Super Formula Bar (enkelt redigera flera rader med text och formel); Läslayout (enkelt läsa och redigera ett stort antal celler); Klistra in i filtrerat intervall...
  • Sammanfoga celler / rader / kolumner utan att förlora data; Delat cellinnehåll; Kombinera duplicerade rader / kolumner... Förhindra duplicerade celler; Jämför intervall...
  • Välj Duplicera eller Unikt Rader; Välj tomma rader (alla celler är tomma); Super Find och Fuzzy Find i många arbetsböcker; Slumpmässigt val ...
  • Exakt kopia Flera celler utan att ändra formelreferens; Skapa referenser automatiskt till flera ark; Sätt in kulor, Kryssrutor och mer ...
  • Extrahera text, Lägg till text, ta bort efter position, Ta bort mellanslag; Skapa och skriva ut personsökningstalsatser; Konvertera mellan celler innehåll och kommentarer...
  • Superfilter (spara och tillämpa filterscheman på andra ark); Avancerad sortering efter månad / vecka / dag, frekvens och mer; Specialfilter av fet, kursiv ...
  • Kombinera arbetsböcker och arbetsblad; Sammanfoga tabeller baserat på nyckelkolumner; Dela data i flera ark; Batchkonvertera xls, xlsx och PDF...
  • Mer än 300 kraftfulla funktioner. Stöder Office / Excel 2007-2021 och 365. Stöder alla språk. Enkel implementering i ditt företag eller organisation. Fullständiga funktioner 30 dagars gratis provperiod. 60 dagars pengarna tillbaka-garanti.
kte-flik 201905

Fliken Office ger ett flikgränssnitt till Office och gör ditt arbete mycket enklare

  • Aktivera flikredigering och läsning i Word, Excel, PowerPoint, Publisher, Access, Visio och Project.
  • Öppna och skapa flera dokument i nya flikar i samma fönster, snarare än i nya fönster.
  • Ökar din produktivitet med 50 % och minskar hundratals musklick för dig varje dag!
officetab botten
Sortera kommentarer efter
Kommentarer (22)
Inga betyg än. Bli först med att betygsätta!
Denna kommentar minimerades av moderatoren på webbplatsen
Tack så mycket ! Det här fungerar utmärkt.

Men hur får man samma funktion/regel att fungera för en rad celler, till exempel längs en hel kolumn?

Jag har en lista över mitt företags kontakter på olika rader, med deras kontaktuppgifter i olika kolumner, och jag vill lägga till en kolumn som registrerar och räknar antalet gånger en given cell längs varje rad ändras. Koden du gav fungerar utmärkt, men bara för en cell i taget!

Jag är ny på VBA, så jag skulle verkligen uppskatta ditt stöd.

Jag försökte lägga till ett antal celler i koden, så istället för "B9" och "C9", som ges i exemplet ovan, lekte jag med varianter som "B:B", "C:C" eller "B9" :B1000" och "C9:C1000", utan någon framgång.

Tack på förhand
Denna kommentar minimerades av moderatoren på webbplatsen
Hej jan
Försök med VBA-koden nedan. Hoppas det kan hjälpa. Tack för din kommentar.

Privata delarkivsförändring (ByVal-mål som område)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Ställ in xSRg = Range("B9:B1000")
Ställ in xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
För xFNum = 1 Till xSRg.count
Om Target = xSRg.Item(xFNum) Då
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Nästa xFNum
Application.EnableEvents = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal,

Det här är lysande, på min matris har jag använt det här på en av kolumnerna men jag har kämpat för att duplicera detta över flera kolumner. Har du en lösning?

Tack på förhand
Denna kommentar minimerades av moderatoren på webbplatsen
Kan du ge hela koduppsättningen? Jag antar att Crystals kod integreras med annan kod? Tack
Denna kommentar minimerades av moderatoren på webbplatsen
Hej kristall,

Jag har ett problem med koden. Om cellen till exempel, om jag går in

B9 som "Apple" ökar sedan C9 med 1
B10 som "Ball" ökar sedan C10 med 1
Men om jag går in
B11 som "Apple" igen så kommer C9 att ökas med 1, och inte C11

Det verkar som om det ökar raden med den första förekomsten av värdet och inte den faktiska redigerade raden.

Finns det något sätt att bara öka cellen i samma rad och inte en föregående rad?

Tack.
Denna kommentar minimerades av moderatoren på webbplatsen
Fick du reda på det här. Jag är också intresserad av detta för att kontrollera flera celler. Har inte testat det än.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Kevin,

Följande kod kan hjälpa dig att lösa problemet. Tack för din kommentar.
Privata delarkivsförändring (ByVal-mål som område)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Ställ in xSRg = Range("B9:B1000")
Ställ in xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
För xFNum = 1 Till xSRg.count
Om Target = xSRg.Item(xFNum) Då
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Nästa xFNum
Application.EnableEvents = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
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 comenzar. podrás ayudarme. Tack!
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Alla,

Lösningen som tillhandahålls under "Antal gånger en cell har ändrats med VBA-kod" är bra om vi bara spårar ändringar i EN CELL. Vänligen föreslå vilka ändringar som behövs om spårningen ska göras för flera celler. Om det finns flera celler bör den inkrementella räknaren visas bredvid cellen för vilken värdeändringen spåras.
Denna kommentar minimerades av moderatoren på webbplatsen
Ser fram emot hjälp och hjälp för att ha en specifik VBA-kod, som kan appliceras på flera celler i ett kalkylblad.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Shiju,
Försök med VBA-koden nedan. Tack för din kommentar.

Privata delarkivsförändring (ByVal-mål som område)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Ställ in xSRg = Range("B9:B1000")
Ställ in xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
För xFNum = 1 Till xSRg.count
Om Target = xSRg.Item(xFNum) Då
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Nästa xFNum
Application.EnableEvents = True
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
team,

När jag försökte använda:

Privata delarkivsförändring (ByVal-mål som område)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Ställ in xSRg = Range("B9:B1000")
Ställ in xRRg = Range("C9:C1000")

Om jag försiktigt ändrar intervall- och målcellerna gentemot P2:P200 respektive X2:X200, räknar jag inte förändringar i X-kolumnen trots att jag försöker byta celler över flera rader över P2:P200.

Vilken hjälp skulle helst uppskattas.

Hälsningar
JT
Denna kommentar minimerades av moderatoren på webbplatsen
Kan någon hjälpa mig att uppnå kodningen för att räkna tiden som en cell har ändrats till "Revalidate" och kan det appliceras nedåt i en kolumn.
Denna kommentar minimerades av moderatoren på webbplatsen
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.
Denna kommentar minimerades av moderatoren på webbplatsen
Hej FELIX MARIÑO,
Vänligen lägg till följande kod efter koden som anges i det här inlägget. När du behöver återställa cellen klickar du på något ord i koden och trycker sedan på F5-tangenten för att köra den.
Sub CleaRCount()
'Updated by Extendoffice 20220527
    xCount = 0
    Range("c9") = 0
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Crystal

Jag har samma problem som RedDragon. Jag försöker spåra datumändringar, till exempel när en agent skickar ett ärende till sin chef anger de manuellt ett datum - detta kan hända mer än en gång på ett ärende så jag försöker använda den här koden för att visa hur många gånger varje ärende har skickats till en chef. Mina problem är:

1) Om flera ärenden skickas till chefer på en dag, ökar räknaren endast den första instansen av det datumet, inte bredvid raderna i fråga.
2) Varje gång jag lämnar arket, öppnar det igen och ändrar ett datum, återställs räknaren till "1" - hur skulle jag få detta att föras över och inte återställas när arket öppnas igen?

All hjälp är mycket uppskattad och tack så mycket för det du har gjort hittills.

Gadjus
Denna kommentar minimerades av moderatoren på webbplatsen
Hej Gadjus,
Ursäkta besväret. Följande VBA-kod kan göra dig en tjänst. Vänligen ge det ett försök.

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
Denna kommentar minimerades av moderatoren på webbplatsen
Jag provar koden nedan och det fungerar, men jag använder den för att spåra ändringar på datum, eftersom vissa datum är desamma varje gång jag ändrar ett datum som är samma till andra på kolumnen, räknas det igen.
Jag provar den senaste koden men den gör ingenting när jag försöker den. TACK FÖR DENNA BRA KOD!

Privata delarkivsförändring (ByVal-mål som område)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Ställ in xSRg = Range("I3:I1000")
Ställ in xRRg = Range("S3:S1000")

Application.EnableEvents = False
On Error Resume Next
För xFNum = 1 Till xSRg.Count
Om Target = xSRg.Item(xFNum) Då
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Nästa xFNum
Application.EnableEvents = True
End Sub
Sub ClearCount()
'Uppdaterad av Extendoffice 20220527
xCount = 0
Område("S3") = 0
End Sub
Denna kommentar minimerades av moderatoren på webbplatsen
Hej,
Följande VBA-kod kan göra dig en tjänst. Ge det ett försök.
Anmärkningar: På den här raden "Ställ in xRRg = xCell.Offset(0, 10)", numret "10” representerar antalet kolumner som ska förskjutas till höger om startreferensen (här är startreferensen kolumn I, och antalet du vill returnera finns i kolumnen 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
Denna kommentar minimerades av moderatoren på webbplatsen
Tack Crystal, fungerar utmärkt!
Denna kommentar minimerades av moderatoren på webbplatsen
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 sabre é quantas vezes eu mudo o campo B2 até mudar o campo C2 e manter esse valor de alterações no campo D2

exempel: 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
exempel: 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
Denna kommentar minimerades av moderatoren på webbplatsen
Hej wagner cesar,
Följande VBA-kod kan hjälpa. Vänligen ge det ett försök. Tack.

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
Det finns inga kommentarer här ännu
Lämna dina kommentarer
Postar som gäst
×
Betygsätt detta inlägg:
0   Tecken
Föreslagna platser

Följ oss

Copyright © 2009 - www.extendoffice.com. | Alla rättigheter förbehållna. Drivs av ExtendOffice. | | Sitemap
Microsoft och Office-logotypen är varumärken eller registrerade varumärken som tillhör Microsoft Corporation i USA och / eller andra länder.
Skyddad av Sectigo SSL