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

Como contar o total de cliques em uma célula especificada no Excel?

Este artigo trata da contagem do total de cliques em uma célula especificada no Excel.

Conte o total de cliques em uma célula especificada com o código VBA


Conte o total de cliques em uma célula especificada com o código VBA

Faça o seguinte para contar o total de cliques em uma célula especificada no Excel.

1. Na planilha contém a célula de que você precisa para contar o total de cliques, clique com o botão direito do mouse na guia da planilha e clique em Ver código no menu de contexto.

2. No Microsoft Visual Basic para Aplicações janela, copie e cole o código VBA abaixo na janela Código.

Código VBA: conta o total de cliques em uma célula especificada no Excel

Public xRgS, xRgD As Range
Public xNum As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRgS = Range("E2")
    If xRgS Is Nothing Then Exit Sub
    Set xRgD = Range("H2")
    If xRgD Is Nothing Then Exit Sub
    If Intersect(xRgS, Target) Is Nothing Then Exit Sub
    xNum = xNum + 1
    xRgD.Value = xNum
End Sub

Anote os: No código, E2 é a célula de que você precisa para contar o total de cliques e H2 é a célula de saída da contagem. Altere-os conforme necessário.

3. aperte o outro + Q chaves para fechar o Microsoft Visual Basic para Aplicações janela.

A partir de agora, ao clicar na célula E2 nesta planilha especificada, o total de cliques será preenchido automaticamente na célula H2 conforme a imagem abaixo mostrada. Por exemplo, se você clicar na célula E2 5 vezes, o número 5 será exibido na célula H2.


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 (31)
Ainda não há classificações. Seja o primeiro a avaliar!
Este comentário foi feito pelo moderador no site
Como você pode "redefinir" o contador?
Este comentário foi feito pelo moderador no site
Caro Dennis,
Por favor, adicione o código VBA abaixo no final do código original. Toda vez que você executar este código, a contagem será redefinida para 0. Obrigado por seu comentário.

Sub ClearCount()
xRgD.Value = ""
xNúm = 0
End Sub
Este comentário foi feito pelo moderador no site
Cristal,

Você pode fornecer o código VBA completo - para isso? também como eu o aplicaria a uma única linha - cada uma precisando de seu próprio contador?
Este comentário foi feito pelo moderador no site
Oi,
O código VBA completo é o seguinte. Se você quiser redefinir o contador, execute o segundo código VBA. Para aplicar o código a uma única linha, desculpe não poder ajudá-lo ainda.

'O primeiro VBA
xRgS público, xRgD como intervalo
xNum público enquanto
Sub Worksheet_SelectionChange particular (destino ByVal como intervalo)
On Error Resume Next
Se Target.Cells.Count> 1 Then Exit Sub
Definir xRgS = Range("E2")
Se xRgS não for nada, saia do sub
Defina xRgD = Range("H2")
Se xRgD não for nada, saia do sub
Se Intersect (xRgS, Target) não for nada, saia do sub
xNum = xNum + 1
xRgD.Value = xNum
End Sub
'O segundo VBA
Sub ClearCount()
xRgD.Value = ""
xNúm = 0
End Sub
Este comentário foi feito pelo moderador no site
Obrigado pelo código, muito útil.
Não sou programador e gostaria de saber como estender esse processo para todas as linhas. Ou seja, não apenas E2>H2, mas também E3>H3, E4>H4 e assim por diante.
Existe um código para isso?


Obrigado com antecedência!
Este comentário foi feito pelo moderador no site
Oi Guido,

O código VBA abaixo pode ajudá-lo a resolver o problema. Por favor, tente. Obrigado por seu comentário.
Sub Worksheet_SelectionChange particular (destino ByVal como intervalo)
Dim xRgArray como variante
Dim xNum
Dim xStrR, xStrS, xStrD como string
Dim xRgS, xRgD como intervalo

Dim xFNum por muito tempo
xRgArray = Array("E2,H2", "E3,H3", "E4,H4", "E5,H5", "E6,H6")
On Error Resume Next
Se Target.Cells.count > 1, então Exit Sub
Para xFNum = LBound(xRgArray) Para UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Esquerda(xStrR, 2)
xStrD = ""
xStrD = Direita(xStrR, 2)
Definir xRgS = Nada
Definir xRgS = Range(xStrS)
If TypeName(xRgS) <> "Nada" Then
Definir xRgD = Nada
Definir xRgD = Range(xStrD)
If TypeName(xRgD) <> "Nada" Then
If TypeName(Intersect(xRgS, Target)) <> "Nada" Then
xRgD.Value = xRgD.Value + 1
Se acabar
Se acabar
Se acabar
Próximo
End Sub
Este comentário foi feito pelo moderador no site
Obrigado por isso. Tentei e funcionou, porém só funcionou até certo número de células, como podemos estender esse código até o final das células? por exemplo eu digito este código abaixo e só funciona até "G9,G9". Obrigado


Sub Worksheet_SelectionChange particular (destino ByVal como intervalo)
Dim xRgArray como variante
Dim xNum
Dim xStrR, xStrS, xStrD como string
Dim xRgS, xRgD como intervalo

Dim xFNum por muito tempo
xRgArray = Array("C4,C4", "D4,D4", "E4,E4", "F4,F4", "G4,G4", "C6,C6", "D6,D6", "E6,E6 ", "F6,F6", "G6,G6", "C7,C7", "D7,D7", "E7,E7", "F7,F7", "G7,G7", "C8,C8", "D8,D8", "E8,E8", "F8,F8", "G8,G8", "C9,C9", "D9,D9", "E9,E9", "F9,F9", "G9" ,G9", "C10,C10", "D10,D10", "E10,E10", "F10,F10", "G10,G10", "C11,C11", "D11,D11", "E11,E11 ", "F11,F11", "G11,G11", "C14,C14", "D14,D14", "E14,E14", "F14,F14", "G14,G14", "C15,C15", "D15,D15", "E15,E15", "F15,F15", "G15,G15", "C16,C16", "D16,D16", "E16,E16", "F16,F16", "G16 ,G16", "C17,C17", "D17,D17", "E17,E17", "F17,F17", "G17,G17", "C18,C18", "D18,D18", "E18,E18 ", "F18,F18", "G18,G18", "C20,C20", "D20,D20", "E20,E20", "F20,F20", "G20,G20")
On Error Resume Next
Se Target.Cells.count > 1, então Exit Sub
Para xFNum = LBound(xRgArray) Para UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Esquerda(xStrR, 2)
xStrD = ""
xStrD = Direita(xStrR, 2)
Definir xRgS = Nada
Definir xRgS = Range(xStrS)
If TypeName(xRgS) <> "Nada" Then
Definir xRgD = Nada
Definir xRgD = Range(xStrD)
If TypeName(xRgD) <> "Nada" Then
If TypeName(Intersect(xRgS, Target)) <> "Nada" Then
xRgD.Value = xRgD.Value + 1
Se acabar
Se acabar
Se acabar
Próximo
End Sub
Este comentário foi feito pelo moderador no site
Oi Ruth
O código é difícil de otimizar para atender às suas necessidades. Desculpe por isso.
Este comentário foi feito pelo moderador no site
o código não lê o número da célula de dois dígitos, ou seja, C10, por que é isso, por favor
Este comentário foi feito pelo moderador no site
Olá, Cristal. Eu tentei esta fórmula, mas ela só reporta através da linha 9. Não contarei a linha 10 e além. Por exemplo, ajustei a fórmula acima para contar cliques individuais em A4, para reportar a E5; A5 para reportar a E5; A6 para reportar a E6, etc. O intervalo total é A4 a A17, o reporte total é E4 a E17. Você pode ajudar? Aqui está o código modificado que usei.



Sub Worksheet_SelectionChange particular (destino ByVal como intervalo)
Dim xRgArray como variante
Dim xNum
Dim xStrR, xStrS, xStrD como string
Dim xRgS, xRgD como intervalo

Dim xFNum por muito tempo
xRgArray = Array("A4,E4", "A5,E5", "A6,E6", "A7,E7", "A8,E8", "A9,E9", "A10,E10", "A11,E11 ", "A12,E12", "A13,E13", "A14,E14", "A15,E15", "A16,E16", "A17,E17")
On Error Resume Next
Se Target.Cells.Count> 1 Then Exit Sub
Para xFNum = LBound(xRgArray) Para UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Esquerda(xStrR, 2)
xStrD = ""
xStrD = Direita(xStrR, 2)
Definir xRgS = Nada
Definir xRgS = Range(xStrS)
If TypeName(xRgS) <> "Nada" Then
Definir xRgD = Nada
Definir xRgD = Range(xStrD)
If TypeName(xRgD) <> "Nada" Then
If TypeName(Intersect(xRgS, Target)) <> "Nada" Then
xRgD.Value = xRgD.Value + 1
Se acabar
Se acabar
Se acabar
Próximo
End Sub
Este comentário foi feito pelo moderador no site
Olá JT,
Obrigado pelo seu feedback. Há algo errado no código original. Você pode tentar o novo código a seguir.
O número 4 nesta mentira: Set xRight = Target.Offset(0, 4) significa que 4 colunas devem ser deslocadas para a direita da referência inicial (a referência inicial é A4:A17). Após deslocar 4 colunas para a direita, os resultados serão exibidos em E4:E17.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Extendoffice 20221010
    Dim xRight As Range

    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("A4:A17")) Is Nothing Then Exit Sub
    Set xRight = Target.Offset(0, 4)
    If TypeName(xRight.Value) = "Double" Then
        xRight.Value = xRight.Value + 1
    ElseIf TypeName(xRight.Value) = "Empty" Then
        xRight.Value = 1
    End If

End Sub
Este comentário foi feito pelo moderador no site
Olá, existe uma maneira de voltar a contar para qualquer número que eu quero? Por exemplo: eu tinha feito 5 cliques, mas eu só queria 3. Então eu mudo o número na célula para 3, e quando eu clico novamente, ele continua de 3.
Obrigado pelo código!
Este comentário foi feito pelo moderador no site
Oi,
Desculpe não poder ajudá-lo com isso, bem-vindo para postar qualquer pergunta sobre o Excel em nosso fórum: https://www.extendoffice.com/forum.html. Você obterá mais suportes do Excel de nossos profissionais ou outros fãs do Excel.
Este comentário foi feito pelo moderador no site
Olá
Há alguma maneira de programar o conteúdo de cliques de acuerdo a la fecha, es decir programar varias celdas para que cuenten con la fecha del dia?
Este comentário foi feito pelo moderador no site
Você pode fornecer um código que permita contar cliques de células A2, B2 até células A14, B14. Desde já, obrigado.
Este comentário foi feito pelo moderador no site
Oi Barbara,
Você quer dizer contar o total de cliques no intervalo A2:B14? Ou cliques para cada célula no intervalo A2:B14?
Este comentário foi feito pelo moderador no site
Como zerar uma contagem? Como redefinir a pontuação?
Este comentário foi feito pelo moderador no site
Oi,
Se você deseja redefinir o contador, adicione o código VBA abaixo no final do código original fornecido acima e execute-o.

Sub ClearCount()
xRgD.Value = ""
xNúm = 0
End Sub
Este comentário foi feito pelo moderador no site
Oi, estou tentando encontrar uma maneira de contar o número de vezes que 20 células diferentes estão sendo clicadas (cada uma deve ser contada separadamente). Encontrei sua sugestão de código VBA, tentei ajustá-la às minhas necessidades específicas, mas não funcionou. você pode por favor aconselhar como o código deve ser escrito? as células que eu gostaria de contar e as células em que os valores devem aparecer são: F12>AU12, F13>AU13, G12>AV12, G13>AV13, H10>AW10, H11>AW11, H12>AW12, H13>AW13 , H14>AW14, H15>AW15, I10>AX10, I11>AX11, I12>AX12, I13>AX13, I14>AX14, I15>AX15, J12>AY12, J13>AY13, K12>AZ12, K13>AZ13).
Este é o código VBA que tentei sem sucesso:

Sub Worksheet_SelectionChange particular (destino ByVal como intervalo)
Dim xRgArray como variante
Dim xNum
Dim xStrR, xStrS, xStrD como string
Dim xRgS, xRgD como intervalo

Dim xFNum por muito tempo
xRgArray = Array("F12,AU12", "F13,AU13", "G12,AV12", "G13,AV13", "H10,AW10", "H11,AW11", "H12,AW12", "H13,AW13 ", "H14,AW14", "H15,AW15", "I10,AX10", "I11,AX11", "I12,AX12", "I13,AX13", "I14,AX14", "I15,AX15", "J12,AY12", "J13,AY13", "K12,AZ12", "K13,AZ13")
On Error Resume Next
Se Target.Cells.Count> 1 Then Exit Sub
Para xFNum = LBound(xRgArray) Para UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Esquerda(xStrR, 2)
xStrD = ""
xStrD = Direita(xStrR, 2)
Definir xRgS = Nada
Definir xRgS = Range(xStrS)
If TypeName(xRgS) <> "Nada" Then
Definir xRgD = Nada
Definir xRgD = Range(xStrD)
If TypeName(xRgD) <> "Nada" Then
If TypeName(Intersect(xRgS, Target)) <> "Nada" Then
xRgD.Value = xRgD.Value + 1
Se acabar
Se acabar
Se acabar
Próximo
End Sub

Agradeço antecipadamente por sua ajuda.
Este comentário foi feito pelo moderador no site
Oi, O código abaixo pode ajudar. Por favor, tente. Obrigada. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRgS, xRgD como intervalo
Dim xStrRg As String
Dim xFNum como inteiro
Escurecer xArr1, xArr2
Se Target.Cells.Count> 1 Then Exit Sub
xStrRg = "F12-AU12; F13-AU13; G12-AV12; G13-AV13; H10-AW10; H11-AW11; H12-AW12; H13-AW13; H14-AW14; H15-AW15; I10-AX10; I11-AX11; I12-AX12; I13-AX13; I14-AX14; I15-AX15; J12-AY12; J13-AY13; K12-AZ12; K13-AZ13"
On Error Resume Next
xArr1 = Split(xStrRg, ";")
Para xFNum = 0 Para UBound(xArr1)
xArr2 = Split(xArr1(xFNum), "-")
Definir xRgS = Range(xArr2(0))
Defina xRgD = Range(xArr2(1))
Se não (Intersect(xRgS, Target) não é nada) então
xRgD.Value = xRgD.Value + 1
Se acabar
Próximo
End Sub
Este comentário foi feito pelo moderador no site
O código corrigido acima é ótimo para a planilha com a qual estou trabalhando, obrigado. Mas tenho uma dúvida sobre adicionar uma macro de tempo para que todos os dias (excluindo fins de semana) a contagem se mova para a próxima linha na planilha, por exemplo:
Carreira 3 - 7/1/2021 "B1-B3; C1-C3; D1-D3" Carreira 4 - 7/2/2021 "B1-B4; C1-C4; D1-D4" Carreira 5 - 7/3/2021 "B1-B5; C1-C5; D1-D5"
Este comentário foi feito pelo moderador no site
Crystal, o código acima é ótimo para a planilha com a qual estou trabalhando, obrigado. Mas tenho uma dúvida sobre adicionar uma macro de tempo para que todos os dias (excluindo fins de semana) a contagem se mova para a próxima linha na planilha, por exemplo:

Linha 3 - 7/1/2021 "B1-B3; C1-C3; D1-D3"
Linha 4 - 7/2/2021 "B1-B4; C1-C4; D1-D4"
Linha 5 - 7/3/2021 "B1-B5; C1-C5; D1-D5"

Se isso é possível? obrigado, Ken
Este comentário foi feito pelo moderador no site
Oi, obrigado por esses códigos VBA, eles quase trabalhar para as minhas necessidades. Temo que o fato de precisar passar dos dois dígitos signifique que não funcionará. Eu preciso ter C8 até C110 e a contagem de contagem correspondente sendo L8 até L110. Você pode ajudar? Muito obrigado antecipadamente.
Este comentário foi feito pelo moderador no site
Oi Andy, O seguinte código VBA pode lhe fazer um favor. Por favor, tente. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim xRgS, xRgD como intervalo
Dim xStrRg As String
Dim xCStr, xVStr como String
Dim xItem como inteiro
xCStr = "C8: C110" 'O intervalo de células que você deseja gravar os cliques de cada célula
xVstr = "L8:L110" 'O intervalo de células para colocar os registros em
Definir xRgS = Range(xCStr)
Definir xRgD = Range(xVStr)
Se não (Intersect(xRgS, Target) não é nada) então
xItem = Alvo.Linha - xRgS.Item(1).Linha + 1
xRgD.Item(xItem).Value = xRgD.Item(xItem).Value + 1
Se acabar
End Sub
Este comentário foi feito pelo moderador no site
Existe uma maneira de retroceder a contagem de números? Por exemplo: eu tinha feito 5 cliques, mas eu só queria 3. Então eu mudo o número na célula para 3, e quando clico novamente, ele continua de 3. OU tem a possibilidade de pressionar outra célula e diminuir a contagem por 1 se isso for mais fácil.
Este comentário foi feito pelo moderador no site
Olá,
j'aimerai comment je pourrais le nombre de clics sur les cellules D10 à M10 et le retranscrire to the ligne R10 et le faire pour toutes les lignes suivante donc compter les clics sur les cellules D11 à M11 et le transcrire à la ligne R11 etc etc ?

cordialmente
Este comentário foi feito pelo moderador no site
Olá DUFOUR,
Para contar o número de cliques de D10 a M10 e gerar o número total de cliques em R10, você pode aplicar o seguinte código VBA para fazer isso.
Anote os: No código, o intervalo "D10:M30" significa que o código só funciona da linha 10 à linha 30, portanto, especifique as linhas que deseja contar.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Extendoffice 20220609
    Dim xNum As Long
    Dim xRgCount, xRg As Range
    
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub

    Set xRg = Range("D10:M30")
    If Intersect(xRg, Target) Is Nothing Then Exit Sub
    Set xRgCount = Range("R" & Target.Row)
    
    If IsNumeric(xRgCount.Value) Then
        xNum = xRgCount.Value + 1
    Else
        xNum = 1
    End If
    xRgCount.Value = xNum
End Sub
Este comentário foi feito pelo moderador no site
Olá. Muchas gracias por los códigos.
Me gustaría saber cómo contar as veces que se hace clic sobre un enlace en una celda.
Muito obrigado.
Este comentário foi feito pelo moderador no site
Olá José Maria,
Para contar os cliques em um hiperlink, você pode tentar o seguinte código VBA.
Suponha que os hiperlinks estejam na coluna A e você queira que o número de cliques seja preenchido na célula correspondente da coluna B (como mostrado na captura de tela abaixo)
Por favor, coloque o seguinte código na janela de planilha (código).

Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
'Updated by Extendoffice 20220805
    Dim Hyperlink As Range
    Set Hyperlink = Target.Range

    Hyperlink.Offset(0, 1) = Hyperlink.Offset(0, 1) + 1
End Sub

https://www.extendoffice.com/images/stories/comments/comment-picture-zxm/clicks_on_a_hyperlink.png
Este comentário foi feito pelo moderador no site
Oi.
obrigado pelo seu código incrível.
conforme eu uso isso, o contador é reiniciado toda vez que eu abro o arquivo,
existe alguma solução para este problema?
eu preciso ver as contagens de cliques em uma janela de tempo maior

desde já, obrigado
Este comentário foi feito pelo moderador no site
Olá Mehrdad,
Lamento responder-lhe tão tarde. O código a seguir pode ajudar a resolver seu problema. Toda vez que você abrir o arquivo, o contador começará a contar a partir do último número contado.

Public xRgS, xRgD As Range
'Updated by Extendoffice 20230407
Public xNum As Long
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRgS = Range("E2")
    If xRgS Is Nothing Then Exit Sub
    Set xRgD = Range("H2")
    If xRgD Is Nothing Then Exit Sub
    If Intersect(xRgS, Target) Is Nothing Then Exit Sub
    xNum = xRgD.Value
    xNum = xNum + 1
    xRgD.Value = xNum
End Sub
Não há comentários postados aqui ainda