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 for Excel Вирішує більшість ваших проблем і підвищує вашу продуктивність на 80%

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

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

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

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

Чи можете ви надати для цього повний код VBA? також як би я застосував його до одного рядка - кожному потрібен свій лічильник?
відповісти
доповідь
0
0
кристал
кристал     Бев Вілсон
Цей коментар був мінімізований модератором на сайті
привіт,
Повний код 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
відповісти
доповідь
0
0
Guido
Guido
Цей коментар був мінімізований модератором на сайті
Дякую за код, дуже корисно.
Я не програміст і хотів би знати, як поширити цей процес на кожен рядок. Тобто не тільки E2>H2, але також E3>H3, E4>H4 і так далі.
Чи є для цього код?


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

Наведений нижче код 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
відповісти
доповідь
0
0
Рут
Рут     кристал
Цей коментар був мінімізований модератором на сайті
Дякую за це. Я спробував, і це спрацювало, але це працювало лише до певної кількості комірок, як ми можемо розширити цей код до кінця клітинок? наприклад, я вводжу цей код нижче, і він працює лише до "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
відповісти
0
0
кристал
кристал     Рут
Цей коментар був мінімізований модератором на сайті
Привіт, Рут!
Код важко оптимізувати для задоволення ваших потреб. Вибач за це.
відповісти
доповідь
0
0
Дан
Дан     кристал
Цей коментар був мінімізований модератором на сайті
код не зчитує двозначний номер клітинки, тобто C10, чому це, будь ласка
відповісти
0
0
JT
JT     кристал
Цей коментар був мінімізований модератором на сайті
Привіт, Кристал. Я спробував цю формулу, але вона звітує лише до рядка 9. Я не буду рахувати рядок 10 і далі. Наприклад, я налаштував наведену вище формулу для підрахунку окремих кліків у форматі A4, щоб звітувати до E5; A5 звітувати E5; A6 для звітування до E6 тощо. Загальний діапазон від A4 до A17, загальна звітність від E4 до E17. Ви можете допомогти? Ось модифікований код, який я використав.



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

Dim xFNum As Long
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
Якщо 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
відповісти
0
0
кристал
кристал     JT
Цей коментар був мінімізований модератором на сайті
Привіт JT,
Спасибі за ваш відгук. В оригінальному коді щось не так. Ви можете спробувати наступний новий код.
Число 4 у цій брехні: Set xRight = Target.Offset(0, 4) означає, що 4 стовпці для зсуву праворуч від початкового посилання (початкове посилання A4:A17). Після зміщення 4 стовпців праворуч результати будуть виведені в 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
відповісти
доповідь
0
0
Димитрій
Димитрій
Цей коментар був мінімізований модератором на сайті
Привіт, чи є спосіб підрахувати будь-яке число, яке я хочу? Наприклад: я зробив 5 кліків, але я просто хотів 3. Тому я зміню число в комірці на 3, а коли я клацаю знову, воно продовжується з 3.
Дякую за код!
відповісти
0
0
кристал
кристал     Димитрій
Цей коментар був мінімізований модератором на сайті
привіт,
На жаль, не можу вам допомогти з цим. Ласкаво просимо опублікувати будь-які запитання щодо Excel на нашому форумі: https://www.extendoffice.com/forum.html. Ви отримаєте більше підтримки Excel від наших професіоналів або інших шанувальників Excel.
відповісти
доповідь
0
0
Ендрю
Ендрю
Цей коментар був мінімізований модератором на сайті
Привіт
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?
відповісти
0
0
Барбара
Барбара
Цей коментар був мінімізований модератором на сайті
Чи можете ви надати код, який дозволяє підраховувати кліки від клітинок A2, B2 до клітинок A14, B14. Заздалегідь спасибі.
відповісти
0
0
кристал
кристал     Барбара
Цей коментар був мінімізований модератором на сайті
Привіт Барбара!
Ви маєте на увазі підрахунок загальної кількості кліків у діапазоні A2:B14? Або клацання для кожної клітинки в діапазоні A2:B14?
відповісти
доповідь
0
0
Реннан Фаріас
Реннан Фаріас
Цей коментар був мінімізований модератором на сайті
Чи є зараза? Як скинути рахунок?
відповісти
0
0
кристал
кристал     Реннан Фаріас
Цей коментар був мінімізований модератором на сайті
привіт,
Якщо ви хочете скинути лічильник, додайте наведений нижче код VBA в кінці вихідного коду, наданого вище, а потім запустіть його.

Sub ClearCount()
xRgD.Value = ""
xNum = 0
End Sub
відповісти
доповідь
0
0
Йоні Вайс324
Йоні Вайс324
Цей коментар був мінімізований модератором на сайті
Привіт, я намагаюся знайти спосіб підрахувати кількість натискань на 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

Наперед дякую за допомогу.
відповісти
доповідь
0
0
кристал
кристал     Йоні Вайс324
Цей коментар був мінімізований модератором на сайті
Привіт, наведений нижче код може допомогти. Будь ласка, спробуйте. Дякую. Приватний додатковий аркуш_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
відповісти
доповідь
0
0
Кен Х.
Кен Х.     кристал
Цей коментар був мінімізований модератором на сайті
Виправлений вище код чудово підходить для аркуша, з яким я працюю, дякую. Але у мене є запитання щодо додавання макросу часу, щоб щодня (крім вихідних) підрахунок переміщався до наступного рядка на аркуші, наприклад:
Ряд 3 - 7 "B1-B2021; C1-C3; D1-D3" Ряд 1 - 3 "B4-B7; C2-C2021; D1-D4" Ряд 1 - 4 "B1-B4; C5-C7; D3-D2021"
відповісти
0
0
KeHGC
KeHGC     кристал
Цей коментар був мінімізований модератором на сайті
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"

Якщо це можливо? дякую, Кен
відповісти
доповідь
0
0
Енді
Енді
Цей коментар був мінімізований модератором на сайті
Привіт, дякую за ці коди VBA, вони майже працювати для моїх потреб. Я боюся, що той факт, що мені потрібно пройти повз двозначні цифри, означає, що це не спрацює. Мені потрібно мати від C8 до C110 і відповідний підрахунок від L8 до L110. Ви можете допомогти? Велике спасибі наперед.
відповісти
0
0
кристал
кристал     Енді
Цей коментар був мінімізований модератором на сайті
Привіт, Енді, наведений нижче код 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
відповісти
доповідь
0
0
Sid
Sid
Цей коментар був мінімізований модератором на сайті
Чи є спосіб повернути кількість чисел назад? Наприклад: я зробив 5 кліків, але я просто хотів 3. Тому я змінюю число в клітинці на 3, і коли я клацаю знову, воно продовжується з 3. АБО я маю можливість натиснути іншу клітинку та зменшити кількість на 1, якщо це легше.
відповісти
0
0
Dufour
Dufour
Цей коментар був мінімізований модератором на сайті
Здравствуйте,
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 і т. д. ?

Сердечно
відповісти
0
0
кристал
кристал     Dufour
Цей коментар був мінімізований модератором на сайті
Привіт, 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
відповісти
доповідь
0
0
Хосе Марія
Хосе Марія
Цей коментар був мінімізований модератором на сайті
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.
Велике спасибі.
відповісти
0
0
кристал
кристал     Хосе Марія
Цей коментар був мінімізований модератором на сайті
Привіт Хосе Марія,
Щоб підрахувати клацання гіперпосилання, ви можете спробувати такий код 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
відповісти
доповідь
0
0
Мехрдад
Мехрдад
Цей коментар був мінімізований модератором на сайті
Привіт.
дякую за ваш чудовий код.
оскільки я використовую це, лічильник перезапускається кожного разу, коли я відкриваю файл,
чи є якесь рішення для цієї проблеми?
Мені потрібно побачити кількість кліків у більшому часовому вікні

заранее спасибо
відповісти
доповідь
0
0
кристал
кристал     Мехрдад
Цей коментар був мінімізований модератором на сайті
Привіт, Мехрдад,
Вибачте, що відповідаю вам так пізно. Наступний код може допомогти вирішити вашу проблему. Кожного разу, коли ви відкриваєте файл, лічильник починає відлік від останнього підрахованого числа.

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
відповісти
доповідь
0
0
There are no comments posted here yet

Слідуй за нами

Copyright © 2009 - WWW.extendoffice.com. | Всі права захищені. На основі ExtendOffice. | Карта сайту
Microsoft та логотип Office є товарними знаками або зареєстрованими товарними знаками Microsoft Corporation у США та / або інших країнах.
Захищений Sectigo SSL