С очередным вопросом обращаюсь за помощью к опытным специалистам по VBA: На одном диапазоне макрос (по двойному клику в диапазоне копирует значение в другую ячейку) отлично работает (файл во вложении). Добавил аналогичный макрос для другого диапазона выдал конфликт имен. Вопрос уже поднимался тут и перепробовал (на продуктиве) все (в т.ч. по предложениям на других сайтах) варианты. Увы, Debug меня встречал после каждой попытки. Вишенкой на торте пытался сделать скрытие диапазонов C:F и J:M двойным кликом по ячейкам С4 и J4 соответственно, но и они не захотели срабатывать.
Подскажите, пожалуйста, как взломать этот "ларчик"
Добрый вечер, всем участникам форума!
С очередным вопросом обращаюсь за помощью к опытным специалистам по VBA: На одном диапазоне макрос (по двойному клику в диапазоне копирует значение в другую ячейку) отлично работает (файл во вложении). Добавил аналогичный макрос для другого диапазона выдал конфликт имен. Вопрос уже поднимался тут и перепробовал (на продуктиве) все (в т.ч. по предложениям на других сайтах) варианты. Увы, Debug меня встречал после каждой попытки. Вишенкой на торте пытался сделать скрытие диапазонов C:F и J:M двойным кликом по ячейкам С4 и J4 соответственно, но и они не захотели срабатывать.
Подскажите, пожалуйста, как взломать этот "ларчик"Anis625
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Cancel = True If Not Intersect(Range("A4:A10"), Target) Is Nothing Then Columns("C:F").EntireColumn.Hidden = False Worksheets("Лист1").Range("C2") = Target ElseIf Not Intersect(Range("H4:H10"), Target) Is Nothing Then Columns("I:M").EntireColumn.Hidden = False Worksheets("Лист1").Range("J2") = Target End If Application.ScreenUpdating = True End Sub
[/vba]
Здравствуйте. Примерно так [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Cancel = True If Not Intersect(Range("A4:A10"), Target) Is Nothing Then Columns("C:F").EntireColumn.Hidden = False Worksheets("Лист1").Range("C2") = Target ElseIf Not Intersect(Range("H4:H10"), Target) Is Nothing Then Columns("I:M").EntireColumn.Hidden = False Worksheets("Лист1").Range("J2") = Target End If Application.ScreenUpdating = True End Sub
Pelena, Отлично все работает. Такого варианта решения не находил в инете. Благодаря Вашему подходу добавил "вишенки на торте" скрытие столбцов по двойному клику и теперь все отлично работает как надо. [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Cancel = True If Not Intersect(Range("A4:A10"), Target) Is Nothing Then Columns("C:F").EntireColumn.Hidden = False Worksheets("Лист1").Range("C2") = Target ElseIf Not Intersect(Range("H4:H10"), Target) Is Nothing Then Columns("I:M").EntireColumn.Hidden = False Worksheets("Лист1").Range("J2") = Target ElseIf Not Intersect(Range("C4"), Target) Is Nothing Then Columns("C:F").EntireColumn.Hidden = True ElseIf Not Intersect(Range("J4"), Target) Is Nothing Then Columns("J:M").EntireColumn.Hidden = True End If
Application.ScreenUpdating = True End Sub
[/vba] Спасибо Вам огромное. Добавлю в свою копилку.
Pelena, Отлично все работает. Такого варианта решения не находил в инете. Благодаря Вашему подходу добавил "вишенки на торте" скрытие столбцов по двойному клику и теперь все отлично работает как надо. [vba]
Код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Application.ScreenUpdating = False Cancel = True If Not Intersect(Range("A4:A10"), Target) Is Nothing Then Columns("C:F").EntireColumn.Hidden = False Worksheets("Лист1").Range("C2") = Target ElseIf Not Intersect(Range("H4:H10"), Target) Is Nothing Then Columns("I:M").EntireColumn.Hidden = False Worksheets("Лист1").Range("J2") = Target ElseIf Not Intersect(Range("C4"), Target) Is Nothing Then Columns("C:F").EntireColumn.Hidden = True ElseIf Not Intersect(Range("J4"), Target) Is Nothing Then Columns("J:M").EntireColumn.Hidden = True End If
Application.ScreenUpdating = True End Sub
[/vba] Спасибо Вам огромное. Добавлю в свою копилку.Anis625
Сообщение отредактировал Anis625 - Среда, 16.09.2020, 09:17