Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 16.10.2019, 08:26   #1
Iskin
Форумчанин
 
Регистрация: 22.09.2008
Сообщений: 308
По умолчанию автофильтр по клику мыши

Всем хорошего дня!
Есть колонка с данными. Подскажите CODE что бы при двойном нажатии на ячейку включался автофильтр с параметром равный значению текущей ячейки.
Вложения
Тип файла: rar 1111.rar (6.4 Кб, 14 просмотров)
Думайте глобально - действуйте локально!
Iskin вне форума Ответить с цитированием
Старый 16.10.2019, 09:32   #2
Elixi
Форумчанин
 
Регистрация: 10.05.2019
Сообщений: 163
По умолчанию

Код:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    If Target.Value = "" Then
        ActiveSheet.Range(Cells(2, 1), Cells(Range("$A$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
    Else
        ActiveSheet.Range(Cells(2, 1), Cells(Range("$A$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
    End If

End Sub
Elixi вне форума Ответить с цитированием
Старый 16.10.2019, 09:59   #3
Iskin
Форумчанин
 
Регистрация: 22.09.2008
Сообщений: 308
По умолчанию

Вставил ваш код, пока ничего не получается.
Вложения
Тип файла: rar 1111.rar (11.1 Кб, 10 просмотров)
Думайте глобально - действуйте локально!
Iskin вне форума Ответить с цитированием
Старый 16.10.2019, 10:10   #4
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Цитата:
Сообщение от Iskin Посмотреть сообщение
Вставил ваш код
не туда вставили. нужно было в Лист вставлять.
2222.xlsm.zip
Serge_Bliznykov вне форума Ответить с цитированием
Старый 16.10.2019, 10:21   #5
Iskin
Форумчанин
 
Регистрация: 22.09.2008
Сообщений: 308
По умолчанию

класс! спасибо всем)
Думайте глобально - действуйте локально!
Iskin вне форума Ответить с цитированием
Старый 16.10.2019, 10:40   #6
Iskin
Форумчанин
 
Регистрация: 22.09.2008
Сообщений: 308
По умолчанию

А если у меня две таких колонки? В рабочем файле это еще и колонка V:V
Думайте глобально - действуйте локально!
Iskin вне форума Ответить с цитированием
Старый 16.10.2019, 10:54   #7
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

попробуйте такой код (подправьте на нужные колонки):

Код:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Application.Intersect(Range("A:A"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(1, 1), Cells(Range("$A$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(1, 1), Cells(Range("$A$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
       End If
  End If
  If Not Application.Intersect(Range("B:B"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(2, 1), Cells(Range("$B$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(2, 1), Cells(Range("$B$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
       End If
  End If
  If Not Application.Intersect(Range("E:E"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(5, 1), Cells(Range("$E$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(5, 1), Cells(Range("$E$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
       End If
  End If
End Sub
Вложения
Тип файла: zip 3333.xlsm.zip (13.4 Кб, 11 просмотров)
Serge_Bliznykov вне форума Ответить с цитированием
Старый 16.10.2019, 11:11   #8
Iskin
Форумчанин
 
Регистрация: 22.09.2008
Сообщений: 308
По умолчанию

Да, все работает. Странное дело отрабатывают оба варианта
Код:
 If Not Application.Intersect(Range("Z:Z"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(26, 1), Cells(Range("$Z$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(26, 1), Cells(Range("$Z$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
Код:
  If Not Application.Intersect(Range("Z:Z"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(1, 1), Cells(Range("$Z$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(1, 1), Cells(Range("$Z$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
И еще одии момент. В раб. файле при защите листа, где стоит "разрешить автофильтр", код не отрабатывает.
Думайте глобально - действуйте локально!

Последний раз редактировалось Iskin; 16.10.2019 в 11:24.
Iskin вне форума Ответить с цитированием
Старый 16.10.2019, 11:47   #9
Iskin
Форумчанин
 
Регистрация: 22.09.2008
Сообщений: 308
По умолчанию

Код:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    
  If Not Application.Intersect(Range("V:V"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(22, 1), Cells(Range("$V$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(22, 1), Cells(Range("$V$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
       End If
  End If
  If Not Application.Intersect(Range("T:T"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(20, 1), Cells(Range("$T$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(20, 1), Cells(Range("$T$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
       End If
  End If
  If Not Application.Intersect(Range("Z:Z"), Range(Target.Address)) Is Nothing Then
       If Target.Value = "" Then
           ActiveSheet.Range(Cells(26, 1), Cells(Range("$Z$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column
       Else
           ActiveSheet.Range(Cells(26, 1), Cells(Range("$Z$2").End(xlDown).Row, 2)).AutoFilter Field:=Target.Column, Criteria1:=Target.Value
       End If
  End If
 ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
        AllowFormattingRows:=True, AllowSorting:=True, AllowFiltering:=True, _
        AllowUsingPivotTables:=True
End Sub
Поставил код на отключение и включение защиту листа. Фильтр срабатывает, но в той ячейке где кликал мышью, данные затираются.
Думайте глобально - действуйте локально!
Iskin вне форума Ответить с цитированием
Старый 16.10.2019, 11:56   #10
Iskin
Форумчанин
 
Регистрация: 22.09.2008
Сообщений: 308
По умолчанию

Пример во вложение
Вложения
Тип файла: rar 3333.rar (26.8 Кб, 17 просмотров)
Думайте глобально - действуйте локально!
Iskin вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перемещение камеры при нажатой левой клавише мыши; проблемы с обзором мыши и видимостью указателя VolodyaBuzin Gamedev - cоздание игр: Unity, OpenGL, DirectX 3 13.09.2019 19:21
Вывести поточные координаты курсора мыши относительно формы и экрана, при нажатии на кнопку реверсивное изменение кнопок мыши C++ carrie bradshaw Помощь студентам 0 06.02.2014 00:21
Как нарисовать квадрат по клику мыши? dekuk C# (си шарп) 3 05.07.2012 15:50
Закрытие окна по клику мыши tumanovalex Qt и кроссплатформенное программирование С/С++ 2 29.05.2011 19:29
TСhart, клик мыши и координаты XY, Определение координат оси при клике мыши Aravild Компоненты Delphi 1 31.01.2009 16:28