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

Як підрахувати загальну кількість кліків у вказаній комірці в Excel?

У цій статті йдеться про підрахунок загальної кількості кліків у певній комірці в Excel.

Підрахуйте загальну кількість кліків у вказаній комірці за допомогою коду VBA


Підрахуйте загальну кількість кліків у вказаній комірці за допомогою коду VBA


Будь ласка, виконайте наступні дії, щоб підрахувати загальну кількість кліків у певній комірці в Excel.

1. На робочому аркуші міститься комірка, для якої потрібно підрахувати її загальну кількість клацань, клацніть правою кнопкою миші вкладку аркуша, а потім клацніть Переглянути код з контекстного меню.

2 В Microsoft Visual Basic для додатків вікно, скопіюйте та вставте нижче код VBA у вікно коду.

Код VBA: підрахуйте загальну кількість кліків у вказаній комірці в 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

примітки: У коді E2 - це комірка, для якої потрібно підрахувати загальну кількість кліків, а H2 - вихідна комірка підрахунку. Будь ласка, змініть їх, як вам потрібно.

3 Натисніть кнопку інший + Q клавіші, щоб закрити Microsoft Visual Basic для додатків вікна.

Відтепер, при натисканні на клітинку E2 на цьому вказаному робочому аркуші, загальна кількість кліків буде автоматично заповнюватися в комірці H2, як показано нижче. Наприклад, якщо натиснути клітинку E2 5 разів, номер 5 відображатиметься в комірці H2.


Найкращі інструменти для підвищення продуктивності офісу

Kutools для Excel вирішує більшість ваших проблем і збільшує продуктивність на 80%

  • Повторне використання: Швидко вставте складні формули, діаграми і все, що ви використовували раніше; Шифрувати комірки з паролем; Створити список розсилки та надсилати електронні листи ...
  • Супер формула бар (легко редагувати кілька рядків тексту та формули); Макет читання (легко читати та редагувати велику кількість комірок); Вставте у відфільтрований діапазон...
  • Об’єднати клітинки / рядки / стовпці без втрати даних; Вміст розділених комірок; Об'єднати повторювані рядки / стовпці... Запобігання дублюючим клітинам; Порівняйте діапазони...
  • Виберіть Повторюваний або Унікальний Рядки; Виберіть Пусті рядки (усі клітинки порожні); Супер знахідка та нечітка знахідка у багатьох робочих зошитах; Випадковий вибір ...
  • Точна копія Кілька клітинок без зміни посилання на формулу; Автоматичне створення посилань на кілька аркушів; Вставте кулі, Прапорці та інше ...
  • Витяг тексту, Додати текст, Видалити за позицією, Видаліть пробіл; Створення та друк проміжних підсумків підкачки; Перетворення вмісту комірок та коментарів...
  • Супер фільтр (зберегти та застосувати схеми фільтрів до інших аркушів); Розширене сортування за місяцем / тижнем / днем, частотою та іншим; Спеціальний фільтр жирним, курсивом ...
  • Поєднайте робочі зошити та робочі аркуші; Об’єднати таблиці на основі ключових стовпців; Розділіть дані на кілька аркушів; Пакетне перетворення xls, xlsx та PDF...
  • Понад 300 потужних функцій. Підтримує Office / Excel 2007-2019 та 365. Підтримує всі мови. Простота розгортання на вашому підприємстві чи в організації. Повна функція 30-денної безкоштовної пробної версії. 60-денна гарантія повернення грошей.
вкладка kte 201905

Вкладка Office забезпечує інтерфейс з вкладками для Office і значно спрощує вашу роботу

  • Увімкніть редагування та читання на вкладках у Word, Excel, PowerPoint, Publisher, Access, Visio та Project.
  • Відкривайте та створюйте кілька документів на нових вкладках того самого вікна, а не в нових вікнах.
  • Збільшує вашу продуктивність на 50% та зменшує сотні клацань миші для вас щодня!
дно офісної таблиці
Коментарі (27)
Поки немає оцінок. Оцініть першим!
Цей коментар був мінімізований модератором на сайті
Як можна «скинути» лічильник?
Цей коментар був мінімізований модератором на сайті
Шановний Денис,
Будь ласка, додайте наведений нижче код VBA в кінці вихідного коду. Щоразу, коли ви запускаєте цей код, підрахунок скидається до 0. Дякуємо за коментар.

Sub ClearCount()
xRgD.Value = ""
xNum = 0
End Sub
Цей коментар був мінімізований модератором на сайті
кришталь,

Чи можете ви надати для цього повний код VBA? також як би я застосував його до одного рядка - кожному потрібен свій лічильник?
Цей коментар був мінімізований модератором на сайті
привіт,
Повний код VBA виглядає наступним чином. Якщо ви хочете скинути лічильник, запустіть другий код VBA. Для застосування коду до одного рядка, вибачте, поки не можу вам допомогти.

«Перший VBA
Загальнодоступні xRgS, xRgD як діапазон
Публічне xNum As Long
Приватний додатковий аркуш_SelectionChange(ByVal Target As Range)
On Error Resume Next
Якщо Target.Cells.Count > 1, то вийдіть із Sub
Встановити xRgS = діапазон ("E2")
Якщо xRgS — нічого, вийдіть із Sub
Встановити xRgD = діапазон ("H2")
Якщо xRgD – нічого, вийдіть із Sub
Якщо Intersect(xRgS, Target) — це нічого, вийдіть із Sub
xNum = xNum + 1
xRgD.Value = xNum
End Sub
«Другий VBA
Sub ClearCount()
xRgD.Value = ""
xNum = 0
End Sub
Цей коментар був мінімізований модератором на сайті
Дякую за код, дуже корисно.
Я не програміст і хотів би знати, як поширити цей процес на кожен рядок. Тобто не тільки E2>H2, але також E3>H3, E4>H4 і так далі.
Чи є для цього код?


Заранее спасибо!
Цей коментар був мінімізований модератором на сайті
Привіт, Гвідо!

Наведений нижче код VBA може допомогти вам вирішити проблему. Будь ласка, спробуйте. Дякую за коментар.
Приватний додатковий аркуш_SelectionChange(ByVal Target As Range)
Dim xRgArray як варіант
Яскравий xNum
Dim xStrR, xStrS, xStrD як рядок
Dim xRgS, xRgD як діапазон

Dim xFNum As Long
xRgArray = Масив("E2,H2", "E3,H3", "E4,H4", "E5,H5", "E6,H6")
On Error Resume Next
Якщо Target.Cells.count > 1, вийдіть із Sub
Для xFNum = LBound(xRgArray) до UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Ліворуч(xStrR, 2)
xStrD = ""
xStrD = Право (xStrR, 2)
Встановіть xRgS = Нічого
Встановити xRgS = діапазон(xStrS)
Якщо TypeName(xRgS) <> "Нічого", Тоді
Встановіть xRgD = Нічого
Встановити xRgD = діапазон(xStrD)
Якщо TypeName(xRgD) <> "Нічого", Тоді
Якщо TypeName(Intersect(xRgS, Target)) <> "Нічого", Тоді
xRgD.Value = xRgD.Value + 1
End If
End If
End If
Далі
End Sub
Цей коментар був мінімізований модератором на сайті
Дякую за це. Я спробував, і це спрацювало, але це працювало лише до певної кількості комірок, як ми можемо розширити цей код до кінця клітинок? наприклад, я вводжу цей код нижче, і він працює лише до "G9,G9". Спасибі


Приватний додатковий аркуш_SelectionChange(ByVal Target As Range)
Dim xRgArray як варіант
Яскравий xNum
Dim xStrR, xStrS, xStrD як рядок
Dim xRgS, xRgD як діапазон

Dim xFNum As Long
xRgArray = Масив("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
Якщо Target.Cells.count > 1, вийдіть із Sub
Для xFNum = LBound(xRgArray) до UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Ліворуч(xStrR, 2)
xStrD = ""
xStrD = Право (xStrR, 2)
Встановіть xRgS = Нічого
Встановити xRgS = діапазон(xStrS)
Якщо TypeName(xRgS) <> "Нічого", Тоді
Встановіть xRgD = Нічого
Встановити xRgD = діапазон(xStrD)
Якщо TypeName(xRgD) <> "Нічого", Тоді
Якщо TypeName(Intersect(xRgS, Target)) <> "Нічого", Тоді
xRgD.Value = xRgD.Value + 1
End If
End If
End If
Далі
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт, Рут!
Код важко оптимізувати для задоволення ваших потреб. Вибач за це.
Цей коментар був мінімізований модератором на сайті
код не зчитує двозначний номер клітинки, тобто C10, чому це, будь ласка
Цей коментар був мінімізований модератором на сайті
Привіт, чи є спосіб підрахувати будь-яке число, яке я хочу? Наприклад: я зробив 5 кліків, але я просто хотів 3. Тому я зміню число в комірці на 3, а коли я клацаю знову, воно продовжується з 3.
Дякую за код!
Цей коментар був мінімізований модератором на сайті
привіт,
На жаль, не можу вам допомогти з цим. Ласкаво просимо опублікувати будь-які запитання щодо Excel на нашому форумі: https://www.extendoffice.com/forum.html. Ви отримаєте більше підтримки Excel від наших професіоналів або інших шанувальників Excel.
Цей коментар був мінімізований модератором на сайті
Привіт
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?
Цей коментар був мінімізований модератором на сайті
Чи можете ви надати код, який дозволяє підраховувати кліки від клітинок A2, B2 до клітинок A14, B14. Заздалегідь спасибі.
Цей коментар був мінімізований модератором на сайті
Привіт Барбара!
Ви маєте на увазі підрахунок загальної кількості кліків у діапазоні A2:B14? Або клацання для кожної клітинки в діапазоні A2:B14?
Цей коментар був мінімізований модератором на сайті
Чи є зараза? Як скинути рахунок?
Цей коментар був мінімізований модератором на сайті
привіт,
Якщо ви хочете скинути лічильник, додайте наведений нижче код VBA в кінці вихідного коду, наданого вище, а потім запустіть його.

Sub ClearCount()
xRgD.Value = ""
xNum = 0
End Sub
Цей коментар був мінімізований модератором на сайті
Привіт, я намагаюся знайти спосіб підрахувати кількість натискань на 20 різних клітинок (кожну потрібно рахувати окремо). Я натрапив на вашу пропозицію коду VBA, спробував налаштувати його відповідно до своїх потреб, але це не спрацює. підкажіть, будь ласка, як писати код? клітинки, які я хотів би порахувати, і клітинки, в яких мають відображатися значення: 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).
Це код VBA, який я спробував безуспішно:

Приватний додатковий аркуш_SelectionChange(ByVal Target As Range)
Dim xRgArray як варіант
Яскравий xNum
Dim xStrR, xStrS, xStrD як рядок
Dim xRgS, xRgD як діапазон

Dim xFNum As Long
xRgArray = Масив("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
Якщо Target.Cells.Count > 1, то вийдіть із Sub
Для xFNum = LBound(xRgArray) до UBound(xRgArray)
xStrR = xRgArray(xFNum)
xStrS = ""
xStrS = Ліворуч(xStrR, 2)
xStrD = ""
xStrD = Право (xStrR, 2)
Встановіть xRgS = Нічого
Встановити xRgS = діапазон(xStrS)
Якщо TypeName(xRgS) <> "Нічого", Тоді
Встановіть xRgD = Нічого
Встановити xRgD = діапазон(xStrD)
Якщо TypeName(xRgD) <> "Нічого", Тоді
Якщо TypeName(Intersect(xRgS, Target)) <> "Нічого", Тоді
xRgD.Value = xRgD.Value + 1
End If
End If
End If
Далі
End Sub

Наперед дякую за допомогу.
Цей коментар був мінімізований модератором на сайті
Привіт, наведений нижче код може допомогти. Будь ласка, спробуйте. Дякую. Приватний додатковий аркуш_SelectionChange(ByVal Target As Range)
Dim xRgS, xRgD як діапазон
Dim xStrRg як рядок
Dim xFNum як ціле число
Розмір xArr1, xArr2
Якщо Target.Cells.Count > 1, то вийдіть із 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, ";")
Для xFNum = 0 до UBound(xArr1)
xArr2 = Split(xArr1(xFNum), "-")
Встановіть xRgS = Діапазон(xArr2(0))
Встановіть xRgD = діапазон(xArr2(1))
Якщо ні (Intersect(xRgS, Target) Is Nothing), то
xRgD.Value = xRgD.Value + 1
End If
Далі
End Sub
Цей коментар був мінімізований модератором на сайті
Виправлений вище код чудово підходить для аркуша, з яким я працюю, дякую. Але у мене є запитання щодо додавання макросу часу, щоб щодня (крім вихідних) підрахунок переміщався до наступного рядка на аркуші, наприклад:
Ряд 3 - 7 "B1-B2021; C1-C3; D1-D3" Ряд 1 - 3 "B4-B7; C2-C2021; D1-D4" Ряд 1 - 4 "B1-B4; C5-C7; D3-D2021"
Цей коментар був мінімізований модератором на сайті
Crystal, наведений вище код чудово підходить для аркуша, з яким я працюю, дякую. Але у мене є запитання щодо додавання макросу часу, щоб щодня (крім вихідних) підрахунок переміщався до наступного рядка на аркуші, наприклад:

Ряд 3 - 7 "В1-В2021; С1-С3; Д1-Д3"
Ряд 4 - 7 "В2-В2021; С1-С4; Д1-Д4"
Ряд 5 - 7 "В3-В2021; С1-С5; Д1-Д5"

Якщо це можливо? дякую, Кен
Цей коментар був мінімізований модератором на сайті
Привіт, дякую за ці коди VBA, вони майже працювати для моїх потреб. Я боюся, що той факт, що мені потрібно пройти повз двозначні цифри, означає, що це не спрацює. Мені потрібно мати від C8 до C110 і відповідний підрахунок від L8 до L110. Ви можете допомогти? Велике спасибі наперед.
Цей коментар був мінімізований модератором на сайті
Привіт, Енді, наведений нижче код VBA може зробити вам послугу. Будь ласка, спробуйте. Приватний додатковий аркуш_SelectionChange(ByVal Target As Range)
Dim xRgS, xRgD як діапазон
Dim xStrRg як рядок
Dim xCStr, xVStr як рядок
Dim xItem як ціле число
xCStr = "C8: C110" 'Діапазон комірок, у які потрібно записати кліки кожної клітинки
xVStr = "L8:L110" 'Діапазон комірок для розміщення записів
Встановити xRgS = діапазон(xCStr)
Встановити xRgD = діапазон (xVStr)
Якщо ні (Intersect(xRgS, Target) Is Nothing), то
xItem = Target.Row - xRgS.Item(1).Row + 1
xRgD.Item(xItem).Значення = xRgD.Item(xItem).Значення + 1
End If
End Sub
Цей коментар був мінімізований модератором на сайті
Чи є спосіб повернути кількість чисел назад? Наприклад: я зробив 5 кліків, але я просто хотів 3. Тому я змінюю число в клітинці на 3, і коли я клацаю знову, воно продовжується з 3. АБО я маю можливість натиснути іншу клітинку та зменшити кількість на 1, якщо це легше.
Цей коментар був мінімізований модератором на сайті
Здравствуйте,
j'aimerai comment je pourrais le nombre de clics sur les cellules D10 à M10 et le retranscrire à la ligne R10 et le faire pour toutes les lignes suivante donc compter les clics sur les cellules D11 à M11 et le transcrire R11 і т. д. ?

Сердечно
Цей коментар був мінімізований модератором на сайті
Привіт, DUFOUR!
Щоб підрахувати кількість клацань від D10 до M10 і вивести загальну кількість кліків у R10, ви можете застосувати наступний код VBA, щоб це зробити.
примітки: У коді діапазон "D10:M30" означає, що код працює лише від рядка 10 до рядка 30, тому вкажіть рядки, які потрібно підрахувати.
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
Цей коментар був мінімізований модератором на сайті
Hola. 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.
Велике спасибі.
Цей коментар був мінімізований модератором на сайті
Привіт Хосе Марія,
Щоб підрахувати клацання гіперпосилання, ви можете спробувати такий код VBA.
Припустімо, що гіперпосилання знаходяться в стовпці A, і ви хочете, щоб кількість клацань була заповнена у відповідній клітинці стовпця B (як показано на знімку екрана нижче)
Будь ласка, вставте наступний код у вікно аркуша (код).

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
There are no comments posted here yet
Залишайте свої коментарі
Публікація як гість
×
Оцініть цю публікацію:
0   Персонажі
Рекомендовані місця