Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Макрос проверки автофильтра на признак отфильтрованных данных
 
#1
11.12.2015 09:47:05
Добрый день, уважаемые знатоки VBA. В очередной раз обращаюсь к Вам за помощью.

На листе в ячейке А2 есть выпадающий список из которого выбирается определенное название товара.

После этого нажимается кнопка и макрос сначала фильтрует таблицу ниже по критерию указанному в ячейке А2. После этого происходит проверка, если в отфильтрованном диапазоне значений нет - макрос должен выдать сообщение "Данных нет", если же в диапазоне содержаться данные, то макрос должен выдать сообщение "ОК".

Проблема в том, что макрос выдает сообщение "данных нет" и в том и другом случае, т.е. если данные в диапазоне отфильтрованы и когда отфильтрованный диапазон не содержит значений, т.е. пустой.

Помогите пожалуйста определить в чем может быть ошибка ?
Код
Sub pro()
 
'снимаем фильтры с таблицы
On Error Resume Next
ActiveSheet.ShowAllData
 LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'фильтруем данные на листе Лист1 по значению из ячейки А2
Range("A5:A" & LastRow).AutoFilter Field:=1, Criteria1:="=" & Range("A2"), Operator:=xlAnd
    
'проверка автофильтра на наличие отфильтрованных данных после фильтрации, критерий фильтрации ячейка А2

If Worksheets("Лист1").AutoFilter.Range("A5:A" & LastRow).SpecialCells(xlCellTypeVisible).Count = "" Then 'если нет отфильтрованных строк, кроме шапки таблице, то
            MsgBox "Данных нет", vbExclamation, "Ошибка"
            ActiveSheet.ShowAllData 'снимаем установленный фильтр
            Exit Sub
        End If
       
MsgBox ("ok")
        
        End Sub
 
 
 
#2
11.12.2015 10:05:45
Я как-то давно создавал такую же тему
Код
Public Sub qqq()
    Dim f As Object, c1, n&
    With ActiveSheet
        If .AutoFilterMode Then
            For Each f In .AutoFilter.Filters
                n = n + 1
                If f.On Then c1 = f.Criteria1: _
                MsgBox "Filter " & n & " is on, criteria 1 = " & c1
            Next
        End If
    End With
End Sub
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок.
А в том, чтобы писать программы, работающие при любом количестве ошибок.
 
 
 
#3
11.12.2015 10:11:15
Например:
Код
Sub jjj()
On Error Resume Next
qqq = ActiveSheet.SpecialCells(xlCellTypeVisible).Count
Debug.Print IsEmpty(qqq)
End Sub
В данном случае нельзя проверять на пустую строку. И обязательно нужна переменная. (без неё у меня не получилось определить пусто кол-во или нет.

Формула массива (ФМ) вводится Ctrl+Shift+Enter
Memento mori
 
 
 
#4
11.12.2015 10:32:36
Цитата
pinguindell написал:
в чем может быть ошибка ?
AutoFilter.Range("A5:A" & LastRow)
У этого метода нет параметров.
Код
Sub pro()
  
'снимаем фильтры с таблицы
ActiveSheet.AutoFilterMode = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'фильтруем данные на листе Лист1 по значению из ячейки А2
Range("A5:A" & LastRow).AutoFilter Field:=1, Criteria1:="=" & Range("A2"), Operator:=xlAnd
     
'проверка автофильтра на наличие отфильтрованных данных после фильтрации, критерий фильтрации ячейка А2
 
If ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Count = 1 Then 'если нет отфильтрованных строк, кроме шапки таблице, то
            MsgBox "Данных нет", vbExclamation, "Ошибка"
            ActiveSheet.ShowAllData 'снимаем установленный фильтр
            Exit Sub
        End If
        
MsgBox ("ok")
         
        End Sub
 
 
 
#5
11.12.2015 10:43:56
Друзья, спасибо, всем, Казанский, тебе в особенности, умеешь навести на правильные мысли.

Теперь работает:
Код
ActiveSheet.AutoFilterMode = False
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A5:A" & LastRow).AutoFilter Field:=1, Criteria1:="=" & Range("A2"), Operator:=xlAnd
      
'ïðîâåðêà àâòîôèëüòðà íà íàëè÷èå îòôèëüòðîâàííûõ äàííûõ ïîñëå ôèëüòðàöèè, êðèòåðèé ôèëüòðàöèè ÿ÷åéêà À2
  
If ActiveSheet.Range("A5:A" & LastRow).SpecialCells(xlCellTypeVisible).Count = 1 Then 'åñëè íåò îòôèëüòðîâàííûõ ñòðîê, êðîìå øàïêè òàáëèöå, òî
            MsgBox "Äàííûõ íåò", vbExclamation, "Îøèáêà"
            On Error Resume Next
            ActiveSheet.ShowAllData 'ñíèìàåì óñòàíîâëåííûé ôèëüòð
            Exit Sub
        End If
         
MsgBox ("ok")

На всякий случай прикрепляю работающий вариант файла, может кому пригодится.
 
 
 
Страницы: 1
Наверх