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

Comment compter le nombre total de clics dans une cellule spécifiée dans Excel?

Cet article parle de compter le nombre total de clics dans une cellule spécifiée dans Excel.

Compter le nombre total de clics dans une cellule spécifiée avec le code VBA


Compter le nombre total de clics dans une cellule spécifiée avec le code VBA


Veuillez procéder comme suit pour compter le nombre total de clics dans une cellule spécifiée dans Excel.

1. Dans la feuille de calcul contient la cellule dont vous avez besoin pour compter le nombre total de clics, cliquez avec le bouton droit sur l'onglet de la feuille, puis cliquez sur Voir le code dans le menu contextuel.

2. dans le Microsoft Visual Basic pour applications , veuillez copier et coller ci-dessous le code VBA dans la fenêtre Code.

Code VBA: comptez le nombre total de clics dans une cellule spécifiée dans 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

Notes: Dans le code, E2 est la cellule dont vous avez besoin pour compter le nombre total de clics et H2 est la cellule de sortie du comptage. Veuillez les changer selon vos besoins.

3. appuie sur le autre + Q touches pour fermer le Microsoft Visual Basic pour applications fenêtre.

À partir de maintenant, lorsque vous cliquez sur la cellule E2 dans cette feuille de calcul spécifiée, le total des clics sera automatiquement renseigné dans la cellule H2 comme illustré ci-dessous. Par exemple, si vous cliquez 2 fois sur la cellule E5, le numéro 5 sera affiché dans la cellule H2.


Les meilleurs outils de productivité de bureau

Kutools for Excel résout la plupart de vos problèmes et augmente votre productivité de 80%

  • Réutilisation: Insérer rapidement formules complexes, graphiques et tout ce que vous avez utilisé auparavant; Crypter les cellules avec mot de passe; Créer une liste de diffusion et envoyer des e-mails ...
  • Barre Super Formula (modifiez facilement plusieurs lignes de texte et de formule); Disposition de lecture (lire et modifier facilement un grand nombre de cellules); Coller dans la plage filtréeplus
  • Fusionner les cellules / lignes / colonnes sans perdre de données; Contenu des cellules divisées; Combiner des lignes / colonnes en double... Empêcher les cellules en double; Comparer les gammesplus
  • Sélectionnez Dupliquer ou Unique Lignes; Sélectionnez les lignes vides (toutes les cellules sont vides); Super Find et Fuzzy Find dans de nombreux classeurs; Sélection aléatoire ...
  • Copie exacte Plusieurs cellules sans changer la référence de formule; Créer automatiquement des références à plusieurs feuilles; Insérer des puces, Cases à cocher et plus encore ...
  • Extrait du texte, Ajouter du texte, Supprimer par position, Supprimer l'espace; Créer et imprimer des sous-totaux de pagination; Conversion entre le contenu et les commentaires des cellulesplus
  • Super filtre (enregistrer et appliquer des schémas de filtrage à d'autres feuilles); Tri avancé par mois / semaine / jour, fréquence et plus; Filtre spécial par gras, italique ...
  • Combiner des classeurs et des feuilles de travail; Fusionner les tableaux en fonction des colonnes clés; Diviser les données en plusieurs feuilles; Conversion par lots xls, xlsx et PDFplus
  • Plus de 300 fonctionnalités puissantes. Prend en charge Office / Excel 2007-2019 et 365. Prend en charge toutes les langues. Déploiement facile dans votre entreprise ou organisation. Essai gratuit de 30 jours. Garantie de remboursement de 60 jours.
onglet kte 201905

Office Tab apporte une interface à onglets à Office et simplifie considérablement votre travail

  • Activer l'édition et la lecture par onglets dans Word, Excel, PowerPoint, Publisher, Access, Visio et Project.
  • Ouvrez et créez plusieurs documents dans de nouveaux onglets de la même fenêtre, plutôt que dans de nouvelles fenêtres.
  • Augmente votre productivité de 50% et réduit des centaines de clics de souris chaque jour!
bas de cabine
Commentaires (29)
Pas encore de notes. Soyez le premier à évaluer!
Ce commentaire a été minimisé par le modérateur sur le site
Comment "réinitialiser" le compteur ?
Ce commentaire a été minimisé par le modérateur sur le site
Cher Denis,
Veuillez ajouter le code VBA ci-dessous à la fin du code d'origine. Chaque fois que vous exécuterez ce code, le comptage sera remis à 0. Merci pour votre commentaire.

Sous ClearCount()
xRgD.Valeur = ""
xNum = 0
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Cristal,

Pouvez-vous fournir le code VBA complet - pour cela ? aussi comment l'appliquerais-je à une seule ligne - chacune nécessitant son propre compteur?
Ce commentaire a été minimisé par le modérateur sur le site
Hi,
Le code VBA complet est le suivant. Si vous souhaitez réinitialiser le compteur, veuillez exécuter le deuxième code VBA. Pour appliquer le code à une seule ligne, désolé, je ne peux pas encore vous aider.

'Le premier VBA
Public xRgS, xRgD As Range
Public xNum tant que longtemps
Private Sub Worksheet_SelectionChange (Cible ByVal en tant que plage)
On Error Resume Next
Si Target.Cells.Count > 1 Alors Quittez Sub
Définir xRgS = Plage("E2")
Si xRgS n'est rien, quittez Sub
Définir xRgD = Plage("H2")
Si xRgD n'est rien, quittez Sub
Si l'intersection (xRgS, cible) n'est rien, quittez le sous-marin
xNum = xNum + 1
xRgD.Valeur = xNum
End Sub
'Le deuxième VBA
Sous ClearCount()
xRgD.Valeur = ""
xNum = 0
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Merci pour le code, très utile.
Je ne suis pas programmeur et j'aimerais savoir comment étendre ce processus à chaque ligne. C'est-à-dire non seulement E2>H2 mais aussi E3>H3, E4>H4, etc.
Existe-t-il un code pour cela ?


Je vous remercie à l'avance!
Ce commentaire a été minimisé par le modérateur sur le site
Salut Guido,

Le code VBA ci-dessous peut vous aider à résoudre le problème. Veuillez essayer. Merci pour votre commentaire.
Private Sub Worksheet_SelectionChange (Cible ByVal en tant que plage)
Dim xRgArray comme variante
Dim xNum
Dim xStrR, xStrS, xStrD en tant que chaîne
Dim xRgS, xRgD As Range

Atténuer xFNum aussi longtemps
xRgTableau = Tableau("E2,H2", "E3,H3", "E4,H4", "E5,H5", "E6,H6")
On Error Resume Next
Si Target.Cells.count > 1 Alors Quitter le sous-marin
Pour xFNum = LBound(xRgArray) Vers UBound(xRgArray)
xStrR = xRgTableau(xFNum)
xStrS = ""
xStrS = Gauche(xStrR, 2)
xStrD = ""
xStrD = Droite(xStrR, 2)
Définir xRgS = Rien
Définir xRgS = Plage(xStrS)
Si TypeName(xRgS) <> "Rien" Alors
Définir xRgD = Rien
Définir xRgD = Plage(xStrD)
Si TypeName(xRgD) <> "Rien" Alors
Si TypeName(Intersect(xRgS, Target)) <> "Rien" Alors
xRgD.Valeur = xRgD.Valeur + 1
Si fin
Si fin
Si fin
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Merci pour cela. J'ai essayé et cela a fonctionné, mais cela n'a fonctionné que jusqu'à un certain nombre de cellules, comment pouvons-nous étendre ce code jusqu'à la fin des cellules ? par exemple, je tape ce code ci-dessous et cela ne fonctionne que jusqu'à "G9, G9". Merci


Private Sub Worksheet_SelectionChange (Cible ByVal en tant que plage)
Dim xRgArray comme variante
Dim xNum
Dim xStrR, xStrS, xStrD en tant que chaîne
Dim xRgS, xRgD As Range

Atténuer xFNum aussi longtemps
xRgTableau = Tableau("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
Si Target.Cells.count > 1 Alors Quitter le sous-marin
Pour xFNum = LBound(xRgArray) Vers UBound(xRgArray)
xStrR = xRgTableau(xFNum)
xStrS = ""
xStrS = Gauche(xStrR, 2)
xStrD = ""
xStrD = Droite(xStrR, 2)
Définir xRgS = Rien
Définir xRgS = Plage(xStrS)
Si TypeName(xRgS) <> "Rien" Alors
Définir xRgD = Rien
Définir xRgD = Plage(xStrD)
Si TypeName(xRgD) <> "Rien" Alors
Si TypeName(Intersect(xRgS, Target)) <> "Rien" Alors
xRgD.Valeur = xRgD.Valeur + 1
Si fin
Si fin
Si fin
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut ruth
Le code est difficile à optimiser pour répondre à vos besoins. Désolé pour ça.
Ce commentaire a été minimisé par le modérateur sur le site
le code ne lit pas le numéro de cellule à deux chiffres, c'est-à-dire C10 pourquoi est-ce s'il vous plaît
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, Cristal. J'ai essayé cette formule, mais elle ne rapporte que jusqu'à la ligne 9. Je ne compterai pas la ligne 10 et au-delà. Par exemple, j'ai ajusté la formule ci-dessus pour compter les clics individuels dans A4, pour faire rapport à E5 ; A5 se présenter à E5 ; A6 à signaler à E6, etc. La plage totale va de A4 à A17, le rapport total va de E4 à E17. Pouvez-vous aider? Voici le code modifié que j'ai utilisé.



Private Sub Worksheet_SelectionChange (Cible ByVal en tant que plage)
Dim xRgArray comme variante
Dim xNum
Dim xStrR, xStrS, xStrD en tant que chaîne
Dim xRgS, xRgD As Range

Atténuer xFNum aussi longtemps
xRgTableau = Tableau("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
Si Target.Cells.Count > 1 Alors Quittez Sub
Pour xFNum = LBound(xRgArray) Vers UBound(xRgArray)
xStrR = xRgTableau(xFNum)
xStrS = ""
xStrS = Gauche(xStrR, 2)
xStrD = ""
xStrD = Droite(xStrR, 2)
Définir xRgS = Rien
Définir xRgS = Plage(xStrS)
Si TypeName(xRgS) <> "Rien" Alors
Définir xRgD = Rien
Définir xRgD = Plage(xStrD)
Si TypeName(xRgD) <> "Rien" Alors
Si TypeName(Intersect(xRgS, Target)) <> "Rien" Alors
xRgD.Valeur = xRgD.Valeur + 1
Si fin
Si fin
Si fin
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut JT,
Merci pour votre avis. Il y a quelque chose qui ne va pas dans le code d'origine. Vous pouvez essayer le nouveau code suivant.
Le nombre 4 dans ce mensonge : Set xRight = Target.Offset(0, 4) signifie que 4 colonnes doivent être décalées à droite de la référence de départ (la référence de départ est A4:A17). Après avoir décalé 4 colonnes vers la droite, les résultats seront sortis en 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
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour, il existe un moyen de sauvegarder le comptage pour n'importe quel nombre que je veux? Par exemple : j'avais fait 5 clics, mais je voulais juste 3. Donc je change le nombre dans la cellule en 3, et quand je clique à nouveau, ça continue à partir de 3.
Merci pour le code !
Ce commentaire a été minimisé par le modérateur sur le site
Hi,
Désolé de ne pas pouvoir vous aider, n'hésitez pas à poster toute question concernant Excel sur notre forum : https://www.extendoffice.com/forum.html. Vous obtiendrez plus de supports Excel de la part de nos professionnels ou d'autres fans d'Excel.
Ce commentaire a été minimisé par le modérateur sur le site
Salut
Hay alguna manera de programar el conteo de clicks de acuerdo a la fecha, es decir programar varias celdas para que cuenten con la fecha del día?
Ce commentaire a été minimisé par le modérateur sur le site
Pouvez-vous fournir un code permettant de compter les clics des cellules A2, B2 aux cellules A14, B14. Merci d'avance.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour Barbara,
Voulez-vous dire compter le nombre total de clics dans la plage A2 : B14 ? Ou des clics pour chaque cellule de la plage A2 : B14 ?
Ce commentaire a été minimisé par le modérateur sur le site
Como zerar un contagem? Comment réinitialiser le score ?
Ce commentaire a été minimisé par le modérateur sur le site
Hi,
Si vous souhaitez réinitialiser le compteur, veuillez ajouter le code VBA ci-dessous à la fin du code d'origine fourni ci-dessus, puis exécutez-le.

Sous ClearCount()
xRgD.Valeur = ""
xNum = 0
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Salut, j'essaie de trouver un moyen de compter le nombre de fois que 20 cellules différentes sont cliquées (chacune doit être comptée séparément). Je suis tombé sur votre suggestion de code VBA, j'ai essayé de l'adapter à mes besoins spécifiques, mais cela ne fonctionnera pas. pouvez-vous s'il vous plaît indiquer comment le code doit être écrit? les cellules que je voudrais compter et les cellules dans lesquelles les valeurs doivent apparaître sont : 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).
Voici le code VBA que j'ai essayé sans succès :

Private Sub Worksheet_SelectionChange (Cible ByVal en tant que plage)
Dim xRgArray comme variante
Dim xNum
Dim xStrR, xStrS, xStrD en tant que chaîne
Dim xRgS, xRgD As Range

Atténuer xFNum aussi longtemps
xRgTableau = Tableau("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
Si Target.Cells.Count > 1 Alors Quittez Sub
Pour xFNum = LBound(xRgArray) Vers UBound(xRgArray)
xStrR = xRgTableau(xFNum)
xStrS = ""
xStrS = Gauche(xStrR, 2)
xStrD = ""
xStrD = Droite(xStrR, 2)
Définir xRgS = Rien
Définir xRgS = Plage(xStrS)
Si TypeName(xRgS) <> "Rien" Alors
Définir xRgD = Rien
Définir xRgD = Plage(xStrD)
Si TypeName(xRgD) <> "Rien" Alors
Si TypeName(Intersect(xRgS, Target)) <> "Rien" Alors
xRgD.Valeur = xRgD.Valeur + 1
Si fin
Si fin
Si fin
Suivant
End Sub

Merci d'avance pour votre aide.
Ce commentaire a été minimisé par le modérateur sur le site
Salut, le code ci-dessous peut aider. Veuillez essayer. Merci. Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRgS, xRgD As Range
Dim xStrRg As String
Dim xFNum en tant qu'entier
Dim xArr1, xArr2
Si Target.Cells.Count > 1 Alors Quittez 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, ";")
Pour xFNum = 0 Vers UBound(xArr1)
xTabl2 = Split(xTabl1(xFNum), "-")
Définir xRgS = Plage(xArr2(0))
Définir xRgD = Plage(xArr2(1))
Si non (l'intersection (xRgS, cible) n'est rien) alors
xRgD.Valeur = xRgD.Valeur + 1
Si fin
Suivant
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Le code corrigé ci-dessus est idéal pour la feuille avec laquelle je travaille, merci. Mais j'ai une question sur l'ajout d'une macro de temps pour que tous les jours (hors week-ends) le décompte passe à la ligne suivante de la feuille par exemple :
Rangée 3 - 7/1/2021 "B1-B3; C1-C3; D1-D3"Rangée 4 - 7/2/2021 "B1-B4; C1-C4; D1-D4"Rangée 5 - 7/3/2021 "B1-B5 ; C1-C5 ; D1-D5"
Ce commentaire a été minimisé par le modérateur sur le site
Crystal, le code ci-dessus est idéal pour la feuille avec laquelle je travaille, merci. Mais j'ai une question sur l'ajout d'une macro de temps pour que tous les jours (hors week-ends) le décompte passe à la ligne suivante de la feuille par exemple :

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

Si cela est possible ? merci, Ken
Ce commentaire a été minimisé par le modérateur sur le site
Salut, merci pour ces codes VBA, ils presque travailler pour mes besoins. Je crains que le fait que je doive dépasser les deux chiffres signifie que cela ne fonctionnera pas. J'ai besoin d'avoir C8 à C110 et le décompte correspondant allant de L8 à L110. Pouvez-vous aider ? Merci d'avance.
Ce commentaire a été minimisé par le modérateur sur le site
Salut Andy, Le code VBA suivant peut vous rendre service. Veuillez essayer. Private Sub Worksheet_SelectionChange (ByVal Target As Range)
Dim xRgS, xRgD As Range
Dim xStrRg As String
Dim xCStr, xVStr As String
Dim xItem As Integer
xCStr = "C8: C110" 'La plage de cellules que vous souhaitez enregistrer les clics de chaque cellule
xVStr = "L8:L110" 'La plage de cellules dans laquelle placer les enregistrements
Définir xRgS = Plage(xCStr)
Définir xRgD = Plage(xVStr)
Si non (l'intersection (xRgS, cible) n'est rien) alors
xItem = Target.Row - xRgS.Item(1).Row + 1
xRgD.Item(xItem).Valeur = xRgD.Item(xItem).Valeur + 1
Si fin
End Sub
Ce commentaire a été minimisé par le modérateur sur le site
Existe-t-il un moyen de revenir en arrière sur le nombre de chiffres ? Par exemple : j'avais fait 5 clics, mais je voulais juste 3. Donc, je change le nombre dans la cellule à 3, et quand je clique à nouveau, cela continue à partir de 3. OU avoir la possibilité d'appuyer sur une autre cellule et de diminuer le nombre par 1 si c'est plus facile.
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour ,
j'aimerai commenter je pourrais le nombre de clics sur les cellules D10 à M10 et le retranscrire à la ligne R10 et le faire pour toutes les lignes suivantes donc compter les clics sur les cellules D11 à M11 et le transcrire à la ligne R11 etc etc ?

cordialement
Ce commentaire a été minimisé par le modérateur sur le site
Bonjour DUFOUR,
Pour compter le nombre de clics de D10 à M10 et générer le nombre total de clics dans R10, vous pouvez appliquer le code VBA suivant pour le faire.
Notes: Dans le code, la plage "D10:M30" signifie que le code ne fonctionne que de la ligne 10 à la ligne 30, veuillez donc spécifier les lignes que vous souhaitez compter.
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
Ce commentaire a été minimisé par le modérateur sur le site
Salut. Muchas gracias por los códigos.
Me gustaría saber cómo contar las veces que se hace clic sobre un enlace en una celda.
Merci beaucoup.
Ce commentaire a été minimisé par le modérateur sur le site
Salut José Maria,
Pour compter les clics sur un lien hypertexte, vous pouvez essayer le code VBA suivant.
Supposons que les hyperliens se trouvent dans la colonne A et que vous souhaitez que le nombre de clics soit renseigné dans la cellule correspondante de la colonne B (comme indiqué dans la capture d'écran ci-dessous)
Veuillez mettre le code suivant dans la fenêtre de la feuille de calcul (code).

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
Il n'y a pas encore de commentaires postés ici
Laisser vos commentaires
Publier en tant qu'invité
×
Évaluez cet article:
0   Personnages
Emplacements suggérés