Страницы: 1
RSS
Исключить из фильтра выделенные значения
 
Есть следующая конструкция:
Код
Sub AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA()
    Dim cl As Range, rng As Range, filterValues() As Variant
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    ReDim filterValues(1 To rng.Count)
    i = 0
    For Each cl In rng
        i = i + 1
        filterValues(i) = cl.Text
    Next cl
    Range("A1").AutoFilter Field:=3, Criteria1:=filterValues, Operator:=xlFilterValues
End Sub

В текущем варианте макрос фильтруетcя по выделенным значениям. А необходимо чтобы он эти значения исключал. Прошу помочь.
 
в строку
Код
Range("A1").AutoFilter Field:=3, Criteria1:=filterValues, Operator:=xlFilterValues

добавить <>
Код
Range("A1").AutoFilter Field:=3, Criteria1:="<>" & filterValues, Operator:=xlFilterValues
Изменено: Ёк-Мок - 23.02.2018 13:30:27
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
Пробовал. Ошибка "Type mismatch".
 
Без файла сложновато...
Может так:
Код
Sub AAA()
    Dim cl As Range, rng As Range, filterValues() As Variant
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    ReDim filterValues(1 To rng.Count)
    i = 0
    For Each cl In rng
        i = i + 1
        filterValues(i) = "<>" & cl.Text
    Next cl
    Range("A1").AutoFilter Field:=3, Criteria1:=filterValues
End Sub
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
Так тоже пробовал. В этом случае он фильтруется только по нижнему последнему значению. Т.е. если выделить ячейки "СПБ" и "Тюмень", макрос отфильтрует только по Тюмени. То же самое если через ctrl выбирать. Выбираем Москву, Иркутск и Красноярску - отфильтровывает только Красноярск. Пример с макросом добавил.
Изменено: neqkeet - 26.02.2018 00:13:06
 
вариант без Автофильтра
Удивление есть начало познания © Surprise me!
И да пребудет с нами сила ВПР.
 
Код
Sub AAA()
  Dim cl As Range, rng As Range, rg As Range, f$
  Set rng = Selection.SpecialCells(xlCellTypeVisible)
  Set rg = Cells(2, 3).Resize(Me.UsedRange.Rows.Count - 1, 1)
  For Each cl In rg
    If Intersect(cl, rng) Is Nothing Then f = f & Chr(9) & cl.Text
  Next cl
  Range("A1").AutoFilter Field:=3, Criteria1:=Split(Right(f, Len(f) - 1), Chr(9)), Operator:=xlFilterValues
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ёк-Мок, спасибо, но нужен вариант именно через фильтр.
Ігор Гончаренко, код будет использоваться в модуле общей книги макросов. Не совсем понял на что нужно заменить в этом случае "Me". Так же хотелось бы иметь возможность фильтроваться по значениям ячеек, которые находятся вне столбца 3.
Изменено: neqkeet - 26.02.2018 09:41:35
 
Me замените на ActiveSheet или Worksheets(Его номер или имя)
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Спасибо! Но макрос работает только если ячейки, которые необходимо скрыть из фильтра уникальные. Это как-то можно обойти? Попробуйте отфильроваться по ячейкам (C8:C9) из примера 2.  
 
напишите так:
Код
  For Each cl In rg
    If rng.Find(cl, , xlValues, xlWhole) Is Nothing Then f = f & Chr(9) & cl.Text
  Next cl
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Извиняюсь, если задолбал  :)  Почему в следующем примере код работает некорректно?  
 
может что-то в данных не так?
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
neqkeet написал:
Извиняюсь, если задолбал    Почему в следующем примере код работает некорректно?  
Почему не корректно? Как написан, так и работает.
Вот только с самого утра понять не могу, что сей макрос вообще делать должен? И по каким критериям и событиям?
 
Цитата
RAN написал:
Почему не корректно? Как написан, так и работает.
Проблема с таблицей в примере 3 действительно была в данных. Заменил ячейки "Специалист" и "Региональный менеджер", заново прописав их вручную и все заработало. Если предложите более простой способ, буду рад.

Цитата
RAN написал:
Вот только с самого утра понять не могу, что сей макрос вообще делать должен? И по каким критериям и событиям?
Критериев и событий нет. Макрос для исключения ненужных значений из фильтра. Гораздо удобнее забиндить данный код на доп. кнопку мыши, чем выкликивать ненужные значения в выпадающем списке. Особенно если значений много.
 
Код
Sub мяу()
    Dim rng As Range, ar As Range, a As Range, arfilter, aK
    Dim f&, i&
    Dim oDic As Object
    f = 3
    With ActiveSheet
        Set rng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)
        arfilter = ActiveSheet.AutoFilter.Range.Columns(f).Value
        Set oDic = CreateObject("Scripting.Dictionary")
        For i = LBound(arfilter) To UBound(arfilter)
            oDic.Item(arfilter(i, 1)) = 0
        Next
        For Each ar In rng.Areas
            For Each a In ar.Columns(f).Cells
                If a.Row <> .AutoFilter.Range.Row Then
                    If oDic.exists(a.Value) Then oDic.Remove (a.Value)
                End If
            Next
        Next
        aK = oDic.keys
        .AutoFilter.Range.AutoFilter Field:=f, Criteria1:=aK, Operator:=xlFilterValues
    End With
End Sub
 
У меня данный код фильтруется по шапке столбца  :)
Макрос Игоря умирает на больших массивах данных, либо вовсе отказывается работать  :(  
Изменено: neqkeet - 27.02.2018 10:48:28
 
Вынужден вернуться к данной теме...

Макрос Ігор Гончаренко, не работает при наличии фильтрации в соседних столбцах таблицы (см. файл с примером). Вернее код пытается сопоставлять значения во всем столбце, без учета скрытых соседним фильтром строк
Код
Sub AAA()
  Dim cl As Range, rng As Range, rg As Range, f$
  Set rng = Selection.SpecialCells(xlCellTypeVisible)
  Set rg = Cells(2, 3).Resize(ActiveSheet.UsedRange.Rows.Count - 1, 1)
    For Each cl In rg
    If rng.Find(cl, , xlValues, xlWhole) Is Nothing Then f = f & Chr(9) & cl.Text
  Next cl
  Range("A1").AutoFilter Field:=3, Criteria1:=Split(Right(f, Len(f) - 1), Chr(9)), Operator:=xlFilterValues
End Sub
Ограничение в виде
Код
Set rg = Cells(2, 3).Resize(ActiveSheet.UsedRange.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible)
приводит к ошибке: Invalid procedure call or argument.

Код мсье  RAN, упорно фильтруются по шапке столбца.

К сожалению, не хватает знаний чтобы переделать ни тот ни другой код. Прошу помочь.
Изменено: neqkeet - 03.04.2018 12:16:02
Страницы: 1
Наверх