Vba excel двойной клик по ячейке - Word и Excel - помощь в работе с программами

Delux

Пользователь

Сообщений: 138
Регистрация: 03.11.2014

02.11.2020 19:32:05

Здравствуйте, подскажите мне пожалуйста. Как запустить форму двойным щелчком по любой ячейки из столбца «B:B», и перейти в вызванную форму. Я в модуле листа сделала так

Код

Private Sub
Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not
Intersect(Target, Range("C:C")) Is Nothing And Target.Columns.Count =
1 Then
        Call Userform1
            Userform1
                .TextBox2 = ActiveCell.Offset(0, 0) 'Наименование
                .TextBox1 = ActiveCell.Offset(0, -1) '№ п/п
                .TextBox3 = ActiveCell.Offset(0, 3) 'Положение                
            End With
        End If
End Sub

И теперь, надо выйти из ячейки и перейти в форму. А как чтобы сразу переходить в форму

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

02.11.2020 19:37:14

Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) if target.column = 2 then cancel = true: Userform1.show End Sub

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Delux

Пользователь

Сообщений: 138
Регистрация: 03.11.2014

02.11.2020 19:51:23

Правильно сделал?

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  if target.column = 2 then cancel = true: Userform1.show

                .TextBox2 = ActiveCell.Offset(0, 0) 'Наименование
                .TextBox1 = ActiveCell.Offset(0, -1) '№ п/п
                .TextBox3 = ActiveCell.Offset(0, 3) 'Положение                
            End With
        End If
End Sub

ругается и выбрасывает в VBA

buchlotnik

Пользователь

Сообщений: 3863
Регистрация: 31.10.2014

Excel 365 Бета-канал

02.11.2020 19:55:30

Цитата
Delux написал: Правильно сделал?

нет, вот это

Код
.TextBox2 = ActiveCell.Offset(0, 0) 'Наименование .TextBox1 = ActiveCell.Offset(0, -1) '№ п/п .TextBox3 = ActiveCell.Offset(0, 3) 'Положение End With

к чему относится, где начинается With? и вообще почему передаете в форму значения отсюда, а не в userform_activate?

Изменено: buchlotnik — 02.11.2020 19:56:54

Соблюдение правил форума не освобождает от модераторского произвола
<#0>

Ігор Гончаренко

Пользователь

Сообщений: 13746
Регистрация: 01.01.1970

02.11.2020 19:58:29

Код

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  if target.column = 2 then 
    cancel = true
    with Userform1
      .TextBox2 = target 'Наименование
      .TextBox1 = target.Offset(0, -1) '№ п/п
      .TextBox3 = target.Offset(0, 3) 'Положение
      .show                
     End With
  End If
End Sub

Delux Пользователь Сообщений: 138 Регистрация: 03.11.2014	Всё равно ругается, модуль в «Лист1» Прикрепленные файлы 1201.xlsm (18.74 КБ)

buchlotnik

Пользователь

Сообщений: 3863
Регистрация: 31.10.2014

Excel 365 Бета-канал

02.11.2020 20:25:16

Цитата
Delux написал: Всё равно ругается

а ничего, что на userform в вашем файле нет ни одного текстбокса?

Изменено: buchlotnik — 02.11.2020 20:26:15

Соблюдение правил форума не освобождает от модераторского произвола
<#0>

	см. сообщение #2 — оно сработает Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Delux

Пользователь

Сообщений: 138
Регистрация: 03.11.2014

02.11.2020 20:32:39

Цитата
Ігор Гончаренко написал: см. сообщение #2 — оно сработает

Дак мне надо как-то под мою задачу, это приладить. Попытался, выдало ошибку см. сообщение #3

buchlotnik

Пользователь

Сообщений: 3863
Регистрация: 31.10.2014

Excel 365 Бета-канал

#10

02.11.2020 20:38:59

Цитата
Delux написал: выдало ошибку

причина в сообщении #7

Соблюдение правил форума не освобождает от модераторского произвола
<#0>

Delux Пользователь Сообщений: 138 Регистрация: 03.11.2014

Ігор Гончаренко Пользователь Сообщений: 13746 Регистрация: 01.01.1970	#12 06.11.2020 11:40:57 оперативно (не прошло и 5 дней) Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

Источник

Baykal555

1 / 1 / 0

Регистрация: 08.09.2017

Сообщений: 391

Событие при двойном клике

26.06.2020, 16:44. Показов 3949. Ответов 14

Метки нет (Все метки)

Всем привет!
Подскажите, пожалуйста, в чем ошибка:
Пытаюсь сделать, чтобы при двойном клике по ячейке А1 появлялся MsgBox, однако условие срабатывает при двойном клике на любую ячейку:

Visual Basic

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If ActiveCell = Range("A1") Then
Cancel = True
MsgBox "Hello"
End If
End Sub

Файл прилагаю.
Спасибо!

Вложения

Лист Microsoft Office Excel.rar (11.8 Кб, 6 просмотров)

АЕ

ᴁ®

3069 / 1735 / 361

Регистрация: 13.12.2016

Сообщений: 5,937

Записей в блоге: 4

26.06.2020, 17:08

Baykal555, пробуйте так

Visual Basic

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Count = 1 And Target.Row = 1 And Target.Column = 1 Then
    MsgBox "Hello"
End If
End Sub

1 / 1 / 0

Регистрация: 08.09.2017

Сообщений: 391

26.06.2020, 17:10

[ТС]

АЕ, так работает. А как прописать, чтобы указывать диапазон? В дальнейшем я планирую сделать цикл.

ᴁ®

3069 / 1735 / 361

Регистрация: 13.12.2016

Сообщений: 5,937

Записей в блоге: 4

26.06.2020, 17:14

Baykal555, логика ведь понятная. ряды и столбики в условии меняйте на нужные диапазоны.

1 / 1 / 0

Регистрация: 08.09.2017

Сообщений: 391

26.06.2020, 18:12

[ТС]

АЕ, а почему мой вариант не работает?

~~passedbyz~~

Заблокирован

26.06.2020, 18:52

Baykal555, если А=В — это не значит что это одна и та же переменная.
Также и у вас — разные ячейки имеют одно значение.

Alex77755

11482 / 3773 / 677

Регистрация: 13.02.2009

Сообщений: 11,145

26.06.2020, 19:59

Сообщение было отмечено Baykal555 как решение

Решение

В дальнейшем я планирую сделать цикл

для региона но без цикла

Visual Basic

1
2
3

If Target.Cells.Count = 1 And Not Intersect(Target, Range("a1:d5")) Is Nothing Then
    MsgBox "В зоне", 64, ""
End If

ᴁ®

3069 / 1735 / 361

Регистрация: 13.12.2016

Сообщений: 5,937

Записей в блоге: 4

26.06.2020, 22:54

Сообщение от Baykal555

а почему мой вариант не работает?

Не судьба….

1 / 1 / 0

Регистрация: 08.09.2017

Сообщений: 391

26.06.2020, 23:16

[ТС]

АЕ, просто пытаюсь понять в чем ошибка…

ᴁ®

3069 / 1735 / 361

Регистрация: 13.12.2016

Сообщений: 5,937

Записей в блоге: 4

26.06.2020, 23:23

Сообщение от Baykal555

просто пытаюсь понять в чем ошибка…

Я обычно в этих ситуациях не напрягаю людей.
Ставлю точки останова в программе, выясняю значение переменных и т.д.
А уж если прошу кого-то, то по крайней мере говорю спасибо.
Дерзайте.

1 / 1 / 0

Регистрация: 08.09.2017

Сообщений: 391

26.06.2020, 23:25

[ТС]

АЕ, спасибо…

1813 / 1135 / 346

Регистрация: 11.07.2014

Сообщений: 4,002

27.06.2020, 07:32

Сообщение от Baykal555

понять в чем ошибка

ActiveCell (или Target) = Range(«A1») это не сравнение объектов, а сравнение значений в этих ячейках.
Другой вариант проверки Target.Address(0,0) = «A1», ну а лучше, как рекомендует Alex77755, через Intersect

1 / 1 / 0

Регистрация: 08.09.2017

Сообщений: 391

28.06.2020, 19:28

[ТС]

Burk, спасибо!

3827 / 2254 / 751

Регистрация: 02.11.2012

Сообщений: 5,930

29.06.2020, 08:55

АЕ, зачем сравнивать к-во выделенных ячеек при двойном клике? Разве можно двойной клик сделать по нескольким ячейкам?

ᴁ®

3069 / 1735 / 361

Регистрация: 13.12.2016

Сообщений: 5,937

Записей в блоге: 4

29.06.2020, 09:01

Сообщение от Vlad999

зачем сравнивать к-во выделенных ячеек при двойном клике? Разве можно двойной клик сделать по нескольким ячейкам?

Vlad999, полностью согласен.

Источник

Имитация двойного клика (VBA)

oggis

Дата: Пятница, 05.07.2013, 17:01 |
Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация:
0
±

Замечаний:
0% ±

Надо чтобы в определенной книге (Excel) в определенном диапазоне ячеек происходила имитация двойного клика.

Помогите реализовать такую задачу.
Спасибо.

Ответить

Serge_007

Дата: Пятница, 05.07.2013, 17:04 |
Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 15894

Репутация:
2623
±

Замечаний:
±

Excel 2016

Цитата (oggis)

имитация двойного клика

Двойной клик ЛКМ в Excel вызывает режим редактирования ячейки. А Вам что надо?

ЮMoney:41001419691823 | WMR:126292472390

Ответить

oggis

Дата: Пятница, 05.07.2013, 17:09 |
Сообщение № 3

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация:
0
±

Замечаний:
0% ±

Цитата (Serge_007)

А Вам что надо?

Чтоб Excel переходил в режим редактирования ячейки, но не редактировал её.
Я пытался использовать Application.DoubleClick, но никакой реакции не происходит.

Ответить

Serge_007

Дата: Пятница, 05.07.2013, 17:13 |
Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 15894

Репутация:
2623
±

Замечаний:
±

Excel 2016

Цитата (oggis)

Чтоб Excel переходил в режим редактирования ячейки, но не редактировал её.

А какой в этом смысл?

ЮMoney:41001419691823 | WMR:126292472390

Ответить

SkyPro

Дата: Пятница, 05.07.2013, 17:31 |
Сообщение № 5

Группа: Друзья

Ранг: Старожил

Сообщений: 1206

Репутация:
255
±

Замечаний:
0% ±

2010

*Проверка телепатии*

После смены формата ячеек нужно каждую «переклацать»?
Попробуйте скопировать пустую ячейку, выделить требуемый диапазон и через спец. вставку выбрать «сложить».

skypro1111@gmail.com

Сообщение отредактировал SkyPro — Пятница, 05.07.2013, 17:32

Ответить

Саня

Дата: Пятница, 05.07.2013, 21:43 |
Сообщение № 6

Группа: Друзья

Ранг: Ветеран

Сообщений: 1067

Репутация:
560
±

Замечаний:
0% ±

XL 2016

Цитата (oggis)

Чтоб Excel переходил в режим редактирования ячейки, но не редактировал её.

Что это?!
При двойном клике (либо F2) происходит переход в режим редактирования, но Excel ничего сам не редактирует

Ладно, шутки в сторону.
Эмуляция тыканья мышью:
[vba]

Код

Private Declare Sub mouse_event Lib «user32» ( _
                     ByVal dwFlags As Long, _
                     ByVal dx As Long, _
                     ByVal dy As Long, _
                     ByVal cButtons As Long, _
                     ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10

Sub ld()
mouse_event MOUSEEVENTF_LEFTDOWN, 0&, 0&, 0&, 0&
End Sub
Sub lu()
mouse_event MOUSEEVENTF_LEFTUP, 0&, 0&, 0&, 0&
End Sub

Sub LeftClick()
ld
lu
End Sub

Sub DblClick()
LeftClick
LeftClick
End Sub

[/vba]

эмуляция проходит, но в excel’е что-то мешает входу в ячейку, хз что…
эмулируем F2:
[vba]

Код

Option Explicit
Private Declare Sub keybd_event Lib «user32.dll» ( _
                     ByVal bVk As Byte, _
                     ByVal bScan As Byte, _
                     ByVal dwFlags As Long, _
                     ByVal dwExtraInfo As Long)
Const KEYEVENTF_KEYUP = &H2
Const VK_F2 = 113

Sub Click_F2()
keybd_event VK_F2, 0, 0, 0
keybd_event VK_F2, 0, KEYEVENTF_KEYUP, 0
End Sub

[/vba]
здесь все норм — попадаем в режим редактирования.

Ответить

KuklP

Дата: Суббота, 06.07.2013, 13:27 |
Сообщение № 7

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

The_Prist

Дата: Суббота, 06.07.2013, 14:14 |
Сообщение № 8

Группа: Друзья

Ранг: Участник

Сообщений: 84

Репутация:
22
±

Замечаний:
0% ±

2010

Есть у Application метод DoubleClick. По крайней мере в 2010 Excel. И если верить справке, то он должен выполнять как раз эмуляцию двойного клика. Но не выполняет.
Притом все можно сделать без API
[vba]

Код

Sub Emul_F2()
Application.SendKeys «{F2}»
Application.SendKeys «{ENTER}»
End Sub

[/vba]
запускаем с листа(через Al+F8)

или можно циклом(показано до 100-ой строки)
[vba]

Код

Sub Emul_F2()
       Dim lCnt As Long
       Do While lCnt < 100
           Application.SendKeys «{F2}»
           Application.SendKeys «{ENTER}»
           lCnt = lCnt + 1
       Loop
End Sub

[/vba]

Errare humanum est, stultum est in errore perseverare

Сообщение отредактировал The_Prist — Суббота, 06.07.2013, 15:10

Ответить

Саня

Дата: Суббота, 06.07.2013, 17:57 |
Сообщение № 9

Группа: Друзья

Ранг: Ветеран

Сообщений: 1067

Репутация:
560
±

Замечаний:
0% ±

XL 2016

с планеты:

Цитата

Ну…Там я не согласен с высказыванием Сани относительно DoubleClick. Если он чего-то не видит — не значит, что этого нет…

Если он чего-то не видит, вы скажите про это мне здесь, а не ему где-то там.

Ответить

oggis

Дата: Суббота, 06.07.2013, 19:15 |
Сообщение № 10

Группа: Пользователи

Ранг: Прохожий

Сообщений: 5

Репутация:
0
±

Замечаний:
0% ±

KuklP, вы правы, я поступил неправильно.
Саня, хотел бы извиниться перед вами и выражаю вам свою благодарность за помощь.

Ответить

Саня

Дата: Суббота, 06.07.2013, 19:49 |
Сообщение № 11

Группа: Друзья

Ранг: Ветеран

Сообщений: 1067

Репутация:
560
±

Замечаний:
0% ±

XL 2016

oggis, благодарность принимаю, извинения нет — мне не за что вас извинять.

Ответить

The_Prist

Дата: Суббота, 06.07.2013, 22:12 |
Сообщение № 12

Группа: Друзья

Ранг: Участник

Сообщений: 84

Репутация:
22
±

Замечаний:
0% ±

2010

[offtop]

Цитата (Саня)

вы скажите про это мне здесь, а не ему где-то там.

Не надо меня сейчас делать каким-то негодяем — когда я писал пост на Планете, я здесь все продублировал и Вы это знаете не хуже меня. Но после моего высказывания относительно DoubleClick Вы потерли здесь свое высказывание, которое я процитировал. Моя цитата стала «ниоткуда». Я отредактировал свой пост, удалив цитату, о чем Вас проинформировал в личке. Про сообщение на Планете забыл и его не подредактировал, после чего надо было уехать. Приехал только сейчас и что вижу — я какой-то невежа, который чего-то не там сказал?
Раз считаете, что разбираться по подобным вопросам лучше не в личке, а прямо в теме — я не против, я свои сообщения не редактирую, если где-то накосячу. Я извинюсь и признаю свою ошибку. Но каждый делает как ему больше нравиться и как привык.[/offtop]

Errare humanum est, stultum est in errore perseverare

Сообщение отредактировал The_Prist — Воскресенье, 07.07.2013, 11:08

Ответить

Serge_007

Дата: Воскресенье, 07.07.2013, 02:07 |
Сообщение № 13

Группа: Админы

Ранг: Местный житель

Сообщений: 15894

Репутация:
2623
±

Замечаний:
±

Excel 2016

Саня, The_Prist, во первых — если уж оффтопите, то для оформления есть соответствующие теги, во вторых — в чём сыр-бор? Чего не поделили? Я вижу что Саша Диме даже плюс поставил за решение. Хватит пререкаться. Одно дело делаем, всё, мир-дружба-жвачка smile

ЮMoney:41001419691823 | WMR:126292472390

Ответить

The_Prist

Дата: Воскресенье, 07.07.2013, 11:22 |
Сообщение № 14

Группа: Друзья

Ранг: Участник

Сообщений: 84

Репутация:
22
±

Замечаний:
0% ±

2010

Сергей, извиняюсь. Оформил свое сообщение оффтопом.

Errare humanum est, stultum est in errore perseverare

Сообщение отредактировал The_Prist — Воскресенье, 07.07.2013, 11:23

Ответить

KuklP

Дата: Воскресенье, 07.07.2013, 11:27 |
Сообщение № 15

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Короче, непонятка вышла. Хватит уже smile

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Serge_007

Дата: Воскресенье, 07.07.2013, 11:32 |
Сообщение № 16

Группа: Админы

Ранг: Местный житель

Сообщений: 15894

Репутация:
2623
±

Замечаний:
±

Excel 2016

Думаю да smile
Надеюсь разобрались и взаимных претензий больше нет.
[/offtop]

ЮMoney:41001419691823 | WMR:126292472390

Ответить

The_Prist

Дата: Воскресенье, 07.07.2013, 11:41 |
Сообщение № 17

Группа: Друзья

Ранг: Участник

Сообщений: 84

Репутация:
22
±

Замечаний:
0% ±

2010

[offtop]Опа…быстро вы…я свое сообщение сразу же затер, оставив только то, что нужно для форума. А пояснения отправил в личку Сергею. А тут уже ответы….
У меня претензий нет и не было, просто некрасиво это[/offtop]

Errare humanum est, stultum est in errore perseverare

Сообщение отредактировал The_Prist — Воскресенье, 07.07.2013, 11:43

Ответить

KuklP

Дата: Воскресенье, 07.07.2013, 11:45 |
Сообщение № 18

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация:
486
±

Замечаний:
0% ±

2003-2010

Ребят, тему все равно ИМХО придется чистить от оффтопа. Так что нет смысла в тегах. Дим, так мне сразу уведомления на агент приходят.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Ответить

Serge_007

Дата: Воскресенье, 07.07.2013, 11:51 |
Сообщение № 19

Группа: Админы

Ранг: Местный житель

Сообщений: 15894

Репутация:
2623
±

Замечаний:
±

Excel 2016

[offtop]

Цитата (The_Prist)

У меня претензий нет и не было

Всё, так можно бесконечно постить smile
Давайте прекращать.
Вопрос ТС решен — тема закрыта.[/offtop]

ЮMoney:41001419691823 | WMR:126292472390

Ответить

Источник

248

29 ноября 2007 года

Dmitry2064

590 / / 06.12.2006

Конечно, напрмер для ячейки А1
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, ByRef Cancel As Boolean)
If Target = [A1] Then MsgBox «Получилось!»
End Sub

Может я чего-то не так делаю или не понял. Но вставив этот код я дважды нажимаю на ячейку и, как и прежде, попадаю в режим ввода текста.

Цитата:

От SkyM@n: Можно юзать просто рисунок.

Так мне-то надо, что бы потом обрабатывался именно тот ряд, в котором этот рисунок или кнопка находятся (происходит изменение цвета заливки всего ряда для обозначения наступления события «выполнено», либо вставка времени в нужную ячейку). Вот можно ли такую привязку сделать?

Может быть так будет понятне (а может и нет, потому что опять многословно):
у меня ряд начинается с названия документа и в сл. ячейках я ставлю время прохождения этапов обработки (время 1-й распечатки, время правки, «сдано»). Пока руками делается так. Я делаю документ, распечатываю его, пишу время (автоматизировать не нужно). Потом мне приносят док на правку. Я его отыскиваю в куче папок, открываю в программе, правлю, распечатываю и руками ставлю время правки. Потом мне дают команду «готово» и я опять отыскиваю в папках этот док и выкладываю его на сервер. (Отыскивать приходится, потому что постоянно занимаешься след. документом, а потом возвращаешься к какому-то из предыдущих).
А при автоматизации, я бы нажав на кнопку в ряду, соответствующем нужному доку, открывал бы его для правки, а нажав сл. кнопку, он бы копировался на сервер без моего лазания по папкам. Пока я это сделал в виде всего двух кнопок. Т.е. мне надо поставить курсор на нужный ряд и потом нажать соотв. кнопку «правка» или «на сервер», которые вынесены в отдельное место. А если бы такие кнопки были сделаны для каждого документа, то не приходилось бы скакать по экрану, а сразу найдя нужный док, тут же и нажать нужную кнопку. Вот такое извращенческое пожелание .

Источник

Remove From My Forums

Question
I would like to be able to double-click on a cell within a table and have excel take me to another table where that value that I double click on is filtered so that I can see all of the values in the 2nd table for the value that I double clicked on in the
first table. For example…I have a list of projects in a table column named «projects» I also have a list of projects in a 2nd table named «Region». If I double click on Project #1, I would like to see all of the values
for Project #1 within my Region table. By using the following code, I can do this. However, I would now like to do this in another column within the same «projects» table. So I can either double click by column name or by Region
and have it sorted in the «Region» table that is in another worksheet.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strCellVal As String
Dim i As Long

    On Error Resume Next


    If Intersect(Target.EntireRow, [Projects[Region]]) Is Nothing Then Exit Sub
    If Target.Cells.Count <> 1 Then Exit Sub


    strCellVal = ActiveCell.Value


    With Sheet3
        .ListObjects(1).Range.AutoFilter 1, Criteria1:=Intersect(Target.EntireRow, [Projects[Region]])
        .Activate
        i = .ListObjects(1).Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
     If i = 1 Then
        .ListObjects(1).Range.End(xlDown).Offset(1, 2).Value = strCellVal
     End If
        .[A1].Select
    End With


    Cancel = True

End Sub

How do I set this up so that I can use the double-click capability in TWO different rows, not just one?

Answers

I think you just need to see where you are double-clicking:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strCellVal As String
Dim i As Long

On Error Resume Next

If Target.Cells.Count <> 1 Then Exit Sub

‘Code to filter on Region

If Not Intersect(Target, [Projects[Region]]) Is Nothing Then
strCellVal = Target.Value
With Sheet3
.ListObjects(1).Range.AutoFilter 1, Criteria1:=Intersect(Target, [Projects[Region]])
.Activate
i = .ListObjects(1).Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
If i = 1 Then
.ListObjects(1).Range.End(xlDown).Offset(1, 2).Value = strCellVal
End If
.[A1].Select
End With
Cancel = True
End If

‘Code to filter on other basis

If Not Intersect(Target, [Projects[OtherField]]) Is Nothing Then
strCellVal = Target.Value
With Sheet3
‘code here to filter
End With
Cancel = True
End If

End Sub
- Edited by
  
  Monday, August 5, 2013 4:38 PM
  edit
- Marked as answer by
  Fei XueMicrosoft employee
  Tuesday, August 20, 2013 1:00 AM
In Sheet1’s codemodule: remove the two instances of

.ListObjects(1).ShowAutoFilter = False

if you want to add filtering: ie, show Region is «US» AND TES Capabilities
is «Capabilities 2»

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim strCellVal As String
Dim i As Long

If Target.Cells.Count <> 1 Then Exit Sub

If Not Intersect(Target, [Projects[Region]]) Is Nothing Then
strCellVal = Target.Value

With Sheet3
.ListObjects(1).ShowAutoFilter = False
.ListObjects(1).Range.AutoFilter 1, Criteria1:=Target.Value
.Activate
i = .ListObjects(1).Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
If i = 1 Then
.ListObjects(1).Range.End(xlDown).Offset(1, 2).Value = strCellVal
End If
.[A1].Select
End With

Cancel = True
End If

If Not Intersect(Target, [Projects[Capabilities]]) Is Nothing Then
strCellVal = ActiveCell.Value

With Sheet3
.ListObjects(1).ShowAutoFilter = False

.ListObjects(1).Range.AutoFilter 3, Criteria1:=Target.Value
.Activate
i = .ListObjects(1).Range.Columns(1).SpecialCells(xlCellTypeVisible).Count
If i = 1 Then
.ListObjects(1).Range.End(xlDown).Offset(1, 2).Value = strCellVal
End If
.[A1].Select
End With

Cancel = True
End If

End Sub
- Edited by
  Bernie Deitrick, Excel MVP 2000-2010
  Thursday, August 8, 2013 6:32 PM
  edit
- Marked as answer by
  George Hua
  Monday, August 12, 2013 1:30 AM

Источник

Событие при двойном клике

Решение

Question

Answers