Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1 2 След.
RSS
Подсчет количества кликов по ячейке
 
Друзья, здравствуйте!
Нашел в интернете макрос (ниже укажу его), который позволяет считать кол-во кликв по одной ячейке, но никак не получается посчитать кол-во кликов по нескольким ячейкам по отдельности. Например, сумма кликов по ячейке Е2 отображается в ячейке Н2, а сумма кликов по ячейке Е4 отображается в ячейке Н4 и т.д. У кого есть какие мысли?
Код
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
Изменено: ksafiullin - 4 Сен 2018 12:31:01
 
ksafiullin, код следует оформлять соответствующим тегом. Ищите такую кнопку (см. скрин) и исправьте своё сообщение.
Тег VBA.jpg (19.2 КБ)
 
Юрий М, спасибо. Сделал
 
ksafiullin, оформите тему согласно правил
пример на даблклик
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If VBA.IsNumeric(Target.Value) Then Target.Value = Target.Value + 1
End Sub
 
ivanok_v2, не понял, если честно.
 
На одиночный (левый) клик , но будет срабатывать и при выделении ячейки клавишами управления курсора. Т.е. при любой активации ячейки:
Код
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("E2")) Is Nothing Then
        Range("H2") = Range("H2") + 1
    End If
    If Not Intersect(Target, Range("E4")) Is Nothing Then
        Range("H4") = Range("H4") + 1
    End If
    ' И т.д.
End Sub
 
ivanok_v2, что-то Вы "не в ту степь" ))
 
Цитата
ksafiullin написал:
Нашел в интернете макрос (ниже укажу его), который позволяет считать кол-во кликв по одной ячейке
макрос считает количество раз выбора ячейки , при том после того как была активна другая. Если уже вы выбрали , то хоть обкликатесь на ней.

Именно с одиночными кликами не прокатит, или надо нырять в API, но если есть четкий набор ячеек,  куда нужно кликать и в них ничего не нужно менять, то проще повесить над ними фигуры, можно даже прозрачные , и к ним привязать макрос(ы).
Изменено: БМВ - 4 Сен 2018 12:40:27
 
Юрий М,а могу я попросить Вас для вот 2-х ячеек описать программу так, чтобы я просто копировал/вставил? Просто ошибку выдает сейчас
 
БМВ,Можно к отдельной фигуре отдельный макрос писать!? Т.е. можно этот макрос прописать на фигуры, да? А где взять имя фигуры, чтобы заменить в программе "Е2"?
 
Именно для двух я сделал, как Вы и просили: Е2 и Е4. Просто скопируйте этот код в модуль листа: правый клик по ярлычку листа - Исходный текст.
 
Цитата
Юрий М написал:
ivanok_v2 , что-то Вы "не в ту степь" ))
название темы
Цитата
Подсчет количества кликов по ячейке
Приведенный код ето и делает, только по дабл клику. что не так?
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If VBA.IsNumeric(Target.Value) Then Target.Value = Target.Value + 1
End Sub
 
ivanok_v2, так тогда надо Target.Value + 2 :-)
 
Цитата
ivanok_v2 написал:
что не так?
Цитата
ksafiullin написал:
Например, сумма кликов по ячейке Е2 отображается в ячейке Н2
Кликаем по одной, а результат в другой )
 
Юрий М,
 
Юрий М, Выдает ошибку
 
У меня не выдаёт.
 
Юрий М,Это нужно вводить в начале?
Код
Public xRgS, xRgD As Range 
Public xNum As Long
 
Где Вы увидели это в МОЁМ варианте? В коде всего 10 строк - вот их и скопируйте. Всё остальное удалите из модуля.
 
Естественно. Это объявление глобальных переменных, в которых, собственно и хранятся результаты. Если их не объявить, то макрос их по умолчанию сочтёт локальными и обнулит по завершению. Это в худшем случае. А в лучшем заявит, что ему такого не объявляли.
 
Доброе время суток
Цитата
Юрий М написал:
но будет срабатывать и при выделении ячейки клавишами управления курсора
Вариант по мотивам предложения Владимира (ZVI), исключающий обработку выделения и управления с клавиатуры.
Код
Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim cursorPos As POINTAPI, posObject As Object
    GetCursorPos cursorPos
    Set posObject = ActiveWindow.RangeFromPoint(cursorPos.x, cursorPos.y)
    If Not Application.Intersect(posObject, Target, Me.Range("$E$2:$E$10")) Is Nothing Then
        posObject.Offset(0, 1).Value = posObject.Offset(0, 1).Value + 1
    End If
End Sub
Updated.
Поспешил с утверждениями. Если оставить курсор в диапазоне $E$2:$E$10 и перемещать активную ячейку только с клавиатуры, то происходит увеличение в случае когда попадаем в ячейку под курсором :(
Изменено: Андрей VG - 4 Сен 2018 13:08:41 (Грамотей, блин. )
 
Код
Sub test()
    With ActiveSheet
    .Range(.Shapes(Application.Caller).TopLeftCell.Address).Offset(, 3) = .Range(.Shapes(Application.Caller).TopLeftCell.Address).Offset(, 3) + 1
    End With
End Sub
 
Порыскал по инету, в принципе. можно двигаться в направлении обработки событий мыши Detect System Wide Mouse Events. Правда, по опыту работы с событиями таймера можно получить проблемы с callback методами, а можно и не получить. Исследовать нужно. Ну, или пользоваться замечательным кодом Михаила - скоро он нас не только в формулах за пояс заткнёт ;)
Изменено: Андрей VG - 4 Сен 2018 13:17:40
 
Посмотрел по ссылке: а стоит ли овчинка выделки - столько кода писать? )
 
Юрий М,  
Изменено: ksafiullin - 4 Сен 2018 13:22:10
 
Вам же компилятор говорит, где ошибка: не закрыта проверка. Где End if потеряли, который у меня в строке №8?
Ну скопируйте Вы код ЦЕЛИКОМ!..
 
БМВ,Круто! Это как сделали?
 
Цитата
Андрей VG написал:
скоро он нас не только в формулах за пояс заткнёт
Нее, мне более трех строк в VBA уже лениво становится писать :-).

На самом деле думал как объединить два метода. Вызов по клику на фигуре покрывающей область, а не одну ячейку, и уже по X,Y определение ячейки, надо которой был клик. можно подумать, поиграться с координатами окон и попробовать пересчитать.
 
см. вложение
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Юрий М,да, точно, все получилось. Сейчас попробую больше ячеек
Страницы: 1 2 След.
Читают тему (гостей: 1)
Наверх