Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Конфликт процедуры дабл клик в четырех диапазонах на листе - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Конфликт процедуры дабл клик в четырех диапазонах на листе (Макросы/Sub)
Конфликт процедуры дабл клик в четырех диапазонах на листе
Anis625 Дата: Среда, 16.09.2020, 00:55 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 439
Репутация: 17 ±
Замечаний: 0% ±

Excel 2013
Добрый вечер, всем участникам форума!

С очередным вопросом обращаюсь за помощью к опытным специалистам по VBA:
На одном диапазоне макрос (по двойному клику в диапазоне копирует значение в другую ячейку) отлично работает (файл во вложении).
Добавил аналогичный макрос для другого диапазона выдал конфликт имен. Вопрос уже поднимался тут и перепробовал (на продуктиве) все (в т.ч. по предложениям на других сайтах) варианты. Увы, Debug меня встречал после каждой попытки.
Вишенкой на торте пытался сделать скрытие диапазонов C:F и J:M двойным кликом по ячейкам С4 и J4 соответственно, но и они не захотели срабатывать.

Подскажите, пожалуйста, как взломать этот "ларчик"
К сообщению приложен файл: 7237545.xlsb(12.6 Kb)
 
Ответить
СообщениеДобрый вечер, всем участникам форума!

С очередным вопросом обращаюсь за помощью к опытным специалистам по VBA:
На одном диапазоне макрос (по двойному клику в диапазоне копирует значение в другую ячейку) отлично работает (файл во вложении).
Добавил аналогичный макрос для другого диапазона выдал конфликт имен. Вопрос уже поднимался тут и перепробовал (на продуктиве) все (в т.ч. по предложениям на других сайтах) варианты. Увы, Debug меня встречал после каждой попытки.
Вишенкой на торте пытался сделать скрытие диапазонов C:F и J:M двойным кликом по ячейкам С4 и J4 соответственно, но и они не захотели срабатывать.

Подскажите, пожалуйста, как взломать этот "ларчик"

Автор - Anis625
Дата добавления - 16.09.2020 в 00:55
Pelena Дата: Среда, 16.09.2020, 08:11 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 16668
Репутация: 3600 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Здравствуйте.
Примерно так
[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
[/vba]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Примерно так
[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
[/vba]

Автор - Pelena
Дата добавления - 16.09.2020 в 08:11
Anis625 Дата: Среда, 16.09.2020, 08:47 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 439
Репутация: 17 ±
Замечаний: 0% ±

Excel 2013
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 - Среда, 16.09.2020, 09:17
 
Ответить
Сообщение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
Дата добавления - 16.09.2020 в 08:47
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Конфликт процедуры дабл клик в четырех диапазонах на листе (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2020 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!