Ir para o conteúdo principal
Note: The other languages of the website are Google-translated. Back to English

Como contar o número de vezes que uma célula é alterada no Excel?

Para contar o número de vezes que uma célula especificada é alterada no Excel, os códigos VBA fornecidos neste artigo podem ajudar.

Contar o número de vezes que uma célula é alterada com código VBA


Contar o número de vezes que uma célula é alterada com código VBA

Os códigos VBA a seguir podem ajudá-lo a contar o número de vezes que uma célula especificada é alterada no Excel.

1. Na planilha que contém uma ou mais células para as quais você precisa calcular a alteração total, clique com o botão direito do mouse na guia da planilha e clique em Ver código no menu de contexto. Veja a imagem:

2. Na abertura Microsoft Visual Basic para Aplicações janela, copie e cole um dos seguintes códigos VBA na Code janela de acordo com suas necessidades.

Código VBA 1: acompanhar alterações em apenas uma célula

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

Anote os: No código, B9 é a célula de que você precisa para contar suas alterações e C9 é a célula para preencher o resultado da contagem. Altere-os conforme necessário.

Código VBA 2: acompanhar alterações em várias células em uma coluna

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

Anote os: Nesta linha "Definir xRRg = xCell.Offset(0, 1)", o número 1 representa o número de colunas a deslocar para a direita da referência inicial (aqui a referência inicialéa coluna B, e a contagem que você deseja retornar está na coluna C que fica ao lado da coluna B). Se você precisar enviar os resultados na coluna S, altere o número 1 para 10.

A partir de agora, quando a célula B9 ou qualquer célula no intervalo B9:B1000 for alterada, o número total de alterações será sobreposto e preenchido automaticamente na célula especificada.


As melhores ferramentas de produtividade para escritório

Kutools for Excel Resolve a maioria dos seus problemas e aumenta sua produtividade em 80%

  • armadilha para peixes: Insira rapidamente fórmulas complexas, gráficos e qualquer coisa que você tenha usado antes; Criptografar células com senha; Criar lista de discussão e enviar emails ...
  • Barra Super Fórmula (edite facilmente várias linhas de texto e fórmula); Layout de leitura (ler e editar facilmente um grande número de células); Colar na faixa filtrada...
  • Mesclar células / linhas / colunas sem perder dados; Dividir o conteúdo das células; Combinar linhas / colunas duplicadas... Evite células duplicadas; Comparar intervalos...
  • Selecione Duplicado ou Único Linhas; Selecione linhas em branco (todas as células estão vazias); Super Find e Fuzzy Find em muitos livros; Seleção aleatória ...
  • Cópia exata Várias células sem alterar a referência da fórmula; Criação automática de referências para várias folhas; Inserir marcadores, Caixas de seleção e mais ...
  • Extrair Texto, Adicionar texto, remover por posição, Remover Espaço; Criar e imprimir subtotais de paginação; Converter entre conteúdo de células e comentários...
  • Super Filtro (salvar e aplicar esquemas de filtro a outras planilhas); Classificação Avançada por mês / semana / dia, frequência e mais; Filtro Especial por negrito, itálico ...
  • Combine pastas de trabalho e planilhas; Mesclar tabelas com base em colunas-chave; Divida os dados em várias folhas; Conversão em lote de xls, xlsx e PDF...
  • Mais de 300 recursos poderosos. Suporta Office / Excel 2007-2021 e 365. Suporta todos os idiomas. Fácil implantação em sua empresa ou organização. Recursos completos de avaliação gratuita de 30 dias. Garantia de devolução do dinheiro em 60 dias.
guia kte 201905

Office Tab Traz a interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
parte inferior da aba do escritório
Comentários (24)
Ainda não há classificações. Seja o primeiro a avaliar!
Este comentário foi feito pelo moderador no site
Muito obrigado ! Isso funciona muito bem.

Mas como você faz com que a mesma função/regra funcione para um intervalo de células, ao longo de uma coluna inteira, por exemplo?

Eu tenho uma lista de contatos da minha empresa em diferentes linhas, com seus detalhes de contato em diferentes colunas, e quero adicionar uma coluna que registre e conte o número de vezes que uma determinada célula ao longo de cada linha é alterada. O código que você deu funciona muito bem, mas apenas para uma célula de cada vez!

Eu sou novo no VBA, então eu agradeceria muito o seu apoio.

Tentei adicionar um intervalo de células no código, então, em vez de "B9" e "C9", como dado no exemplo acima, brinquei com variações como "B:B", "C:C" ou "B9 :B1000" e "C9:C1000", sem sucesso.

Agradecemos antecipadamente,
Este comentário foi feito pelo moderador no site
Oi Jan,
Por favor, tente o código VBA abaixo. Espero que possa ajudar. Obrigado por seu comentário.

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg como intervalo, xCell como intervalo
Dim xSRg, xRRg como intervalo
Dim xFNum por muito tempo

Definir xSRg = Range("B9:B1000")
Definir xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
Para xFNum = 1 Para xSRg.count
Se Alvo = xSRg.Item(xFNum) Então
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
Se acabar
Próximo xFNum
Application.EnableEvents = True
End Sub
Este comentário foi feito pelo moderador no site
Olá Cristal,

Isso é brilhante, na minha matriz eu usei isso em uma das colunas, mas lutei para duplicar isso em várias colunas. Você tem uma solução?

Obrigado antecipadamente
Este comentário foi feito pelo moderador no site
Você poderia fornecer todo o conjunto de códigos? Estou assumindo que o código do Crystal se integra a outro código? Obrigado
Este comentário foi feito pelo moderador no site
Olá cristal,

Estou tendo um problema com o código. Se a célula por exemplo, se eu entrar

B9 como "Apple" então incrementa C9 em 1
B10 como "Bola" então incrementa C10 em 1
No entanto, se eu entrar
B11 como "Apple" novamente, então C9 será incrementado em 1, e não C11

Parece que ele incrementa a linha com a 1ª ocorrência do valor e não a linha editada real.

Existe uma maneira de apenas incrementar a célula na mesma linha e não na linha anterior?

Obrigado.
Este comentário foi feito pelo moderador no site
Você descobriu isso. Também estou interessado nisso para verificar várias células. Ainda não experimentei.
Este comentário foi feito pelo moderador no site
Oi Kevin,

O código a seguir pode ajudá-lo a resolver o problema. Obrigado por seu comentário.
Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg como intervalo, xCell como intervalo
Dim xSRg, xRRg como intervalo
Dim xFNum por muito tempo

Definir xSRg = Range("B9:B1000")
Definir xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
Para xFNum = 1 Para xSRg.count
Se Alvo = xSRg.Item(xFNum) Então
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
Se acabar
Próximo xFNum
Application.EnableEvents = True
End Sub
Este comentário foi feito pelo moderador no site
Gracias de antemano por el aporte, muy útil, sin embargo, quisiera pedir ayuda a fin de su 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 començar. podrás ayudarme. Obrigado!
Este comentário foi feito pelo moderador no site
Olá a todos,

A solução fornecida em "Contagem do número de vezes que uma célula é alterada com código VBA" é boa se estivermos rastreando apenas as alterações em UMA CÉLULA. Por favor, sugira quais modificações são necessárias, se o rastreamento for feito para várias células. No caso de várias células, o contador incremental deve aparecer ao lado da célula para a qual a alteração no valor está sendo rastreada.
Este comentário foi feito pelo moderador no site
Aguardo ajuda e assistência para ter um código VBA específico, que pode ser aplicado a várias células em uma planilha.
Este comentário foi feito pelo moderador no site
Olá Shiju,
Por favor, tente o código VBA abaixo. Obrigado por comentar.

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg como intervalo, xCell como intervalo
Dim xSRg, xRRg como intervalo
Dim xFNum por muito tempo

Definir xSRg = Range("B9:B1000")
Definir xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
Para xFNum = 1 Para xSRg.count
Se Alvo = xSRg.Item(xFNum) Então
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
Se acabar
Próximo xFNum
Application.EnableEvents = True
End Sub
Este comentário foi feito pelo moderador no site
Team,

Quando tentei usar:

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg como intervalo, xCell como intervalo
Dim xSRg, xRRg como intervalo
Dim xFNum por muito tempo

Definir xSRg = Range("B9:B1000")
Definir xRRg = Range("C9:C1000")

alterando cuidadosamente as células Range e Target vis a vis P2: P200 e X2: X200, respectivamente, eu não faço a contagem de alterações na X Column, apesar de tentar alterar as células em várias linhas em P2: P200.

Qualquer ajuda seria muito apreciada.

Saudações
JT
Este comentário foi feito pelo moderador no site
Alguém pode me ajudar a alcançar a codificação para contar o tempo em que uma célula foi alterada para "Revalidar" e isso pode ser aplicado na entrada de uma coluna.
Este comentário foi feito pelo moderador no site
Quisie que me ayudaran de reiniciar o contador a cerocuando lo requiera, es, la cel9 llevarla a cero y comenzar a contar b9 nuevamente.
Este comentário foi feito pelo moderador no site
Olá FELIX MARIÑO,
Por favor, adicione o seguinte código após o código fornecido neste post. Quando você precisar redefinir a célula, clique em qualquer palavra no código e pressione a tecla F5 para executá-lo.
Sub CleaRCount()
'Updated by Extendoffice 20220527
    xCount = 0
    Range("c9") = 0
End Sub
Este comentário foi feito pelo moderador no site
Oi cristal

Estou com o mesmo problema do RedDragon. Estou tentando rastrear alterações de data, por exemplo, quando um agente envia um caso para seu gerente, ele insere uma data manualmente - isso pode acontecer mais de uma vez Em um caso, estou tentando usar este código para mostrar quantas vezes cada caso foi enviado a um gerente. Meus problemas são:

1) Se vários casos forem enviados aos gerentes em um dia, o contador aumenta apenas na primeira instância dessa data, não próximo às linhas em questão.
2) Toda vez que eu sair da planilha, reabri-la e alterar uma data, o contador será redefinido para "1" - como faço para que isso seja transferido e não seja redefinido quando a planilha for reaberta?

Qualquer ajuda é muito apreciada e muito obrigado pelo que você fez até agora.

Gadjus
Este comentário foi feito pelo moderador no site
Olá Gadjus,
Desculpe a inconveniência. O seguinte código VBA pode lhe fazer um favor. Por favor, tente.

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
Este comentário foi feito pelo moderador no site
Eu tento o código abaixo e funciona, mas estou usando para rastrear alterações nas datas, pois algumas datas são iguais toda vez que altero uma data igual a outra na coluna ela conta novamente.
Eu tento o código mais recente, mas ele não faz nada quando eu tento. OBRIGADO POR ESSE GRANDE CÓDIGO!

Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg como intervalo, xCell como intervalo
Dim xSRg, xRRg como intervalo
Dim xFNum por muito tempo

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

Application.EnableEvents = False
On Error Resume Next
Para xFNum = 1 Para xSRg.Count
Se Alvo = xSRg.Item(xFNum) Então
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
Se acabar
Próximo xFNum
Application.EnableEvents = True
End Sub
Sub ClearRCCount()
'Atualizado por Extendoffice 20220527
xCont = 0
Faixa("S3") = 0
End Sub
Este comentário foi feito pelo moderador no site
Oi,
O seguinte código VBA pode lhe fazer um favor. Por favor, tente.
Anote os: Nesta linha "Definir xRRg = xCell.Offset(0, 10)", o número "10” representa o número de colunas a serem deslocadas à direita da referência inicial (aqui a referência inicial é coluna I, e a contagem que você deseja retornar está na coluna 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
Este comentário foi feito pelo moderador no site
Obrigado Cristal, funciona muito bem!
Este comentário foi feito pelo moderador no site
Olá Cristal,

vi que você tem ajudado o pessoal com o 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 fosse maior do que 5 e 2, como no exemplo que eu dei.

espero que tenha tido claro os exemplos. ahahah... abraços
Este comentário foi feito pelo moderador no site
Olá Wagner César,
O seguinte código VBA pode ajudar. Por favor, tente. Obrigada.

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
Este comentário foi feito pelo moderador no site
Olá Cristal,

o código abaixo não funciona se uma célula estiver sendo atualizada dinamicamente por outro VBScript. Eu tenho uma célula que está sendo preenchida por um VBScript e queria contar o número de vezes que a célula está atualizando, mas seu código não está capturando a alteração.

Dim xCount como inteiro
Private Sub Worksheet_Change (ByVal Target As Range)
Dim xRg como intervalo, xCell como intervalo
On Error Resume Next
Se Alvo = Faixa("B9") Então
xContagem = xContagem + 1
Range("C9").Value = xContagem
Se acabar
Application.EnableEvents = False
Set xRg = Application.Intersect(Target.Dependents, Me.Range("B9"))
Se não xRg não é nada, então
xContagem = xContagem + 1
Range("C9").Value = xContagem
Se acabar
Application.EnableEvents = True
End Sub

aqui está o meu código:
Subbotão11_Click()

Worksheets("C4L1").Range("A2:R35").Calcular
Com Planilhas("C4L1")
Intervalo("M2").Calcular
Intervalo("N2").Calcular
Faixa("O2").Calcular
Intervalo("P2").Calcular
Intervalo("Q2").Calcular
Intervalo("R2").Calcular
Terminar com

End Sub

obrigado
Vgee
Este comentário foi feito pelo moderador no site
Olá Vgee,

Não consigo que o evento Excel Worksheet_Change capture as alterações causadas por outro VBScript. Desculpe pela inconveniência.
Não há comentários postados aqui ainda