автофильтр по клику мыши

[Iskin]

Всем хорошего дня!
Есть колонка с данными. Подскажите CODE что бы при двойном нажатии на ячейку включался автофильтр с параметром равный значению текущей ячейки.

[Elixi]

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

[Iskin]

Вставил ваш код, пока ничего не получается.

[Serge_Bliznykov]

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

Вставил ваш код

не туда вставили. нужно было в Лист вставлять.
2222.xlsm.zip

[Iskin]

класс! спасибо всем)

[Iskin]

А если у меня две таких колонки? В рабочем файле это еще и колонка V:V

[Serge_Bliznykov]

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

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

[Iskin]

Да, все работает. Странное дело отрабатывают оба варианта

 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]

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]

Пример во вложение