Добрый день! Прошу помочь: есть таблица, макросом включается фильтр и фильтрует столбец "В" по цвету заливки. Как можно автоматизировать процесс, чтобы если фильтр включен, то появлялось сообщение "Снимите фильтр" и после нажатия "ОК" фильтр выключался (не очищался, а именно выключался), т.к. при включенном фильтре другой макрос выдает ошибку и часть данных пропадает. Заранее благодарен!
Мда, конечно название темы и предложенная там методика может поставить в тупик. 1. А что хотите видеть после нажатия не OK? 2. Может все решается проще, снятием автофильтра в начале макроса?
Юрий М, макросом фильтруется таблица, копируется в новую книгу и отправляется по электронной почте. В книге с данными если использовать макрос поиска при включенном фильтре - выдает ошибку и данные пропадают. Потому необходимо снять фильтр перед поиском, если забыл снять руками... Прошу прощения - файл пример не могу выложить - корпоративный интернет (скачать можно, залить - нет). Спасибо!
Sub Поиск_Выделение()
Dim xRg As Range 'Поиск выделение
Dim xFRg As Range
Dim xStrAddress As String
Dim xVrt As Variant
With ActiveSheet
If .AutoFilter.FilterMode Then .ShowAllData
End With
xVrt = Range("E1")
If xVrt <> "" Then
Set xFRg = ActiveSheet.Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Find(What:=xVrt)
If xFRg Is Nothing Then
If Range("E1") = "Сюда № " Then Exit Sub
MsgBox prompt:="Нет такого ", Title:=""
Range("E1").Select
Selection.ClearContents
Exit Sub
End If
Application.ScreenUpdating = False
xStrAddress = xFRg.Address
Set xRg = xFRg
Do
Set xFRg = ActiveSheet.Cells.FindNext(After:=xFRg)
Set xRg = Application.Union(xRg, xFRg)
Loop Until xFRg.Address = xStrAddress
If xRg.Count > 0 Then
xRg.Interior.ColorIndex = 8
xRg.Offset(, 1).Interior.ColorIndex = 8
ActiveSheet.Range("B1:B" & Cells(Rows.Count, "A").End(xlUp).Row).AutoFilter Field:=1, Criteria1:=RGB(0, 255 _
, 255), Operator:=xlFilterCellColor
xRg.Interior.ColorIndex = xlNone
xRg.Offset(, 1).Interior.ColorIndex = xlNone
Range("E1").Select
Selection.ClearContents
Application.ScreenUpdating = True
End If
End If
End Sub
Почему я должен вам подсказывать, какая, и где у вас ошибка? Это вы должны были сказать. Тогда, вероятно, вы получили бы ответ с вариантом решения проблемы.
Sub qq()
With ActiveSheet
If .AutoFilterMode Then If .AutoFilter.FilterMode Then .ShowAllData
End With
End Sub
Sub ww()
With ActiveSheet
If .AutoFilterMode Then
On Error Resume Next
.ShowAllData
On Error GoTo 0
End If
End With
End Sub
Sub ee()
With ActiveSheet
If .AutoFilterMode Then .[a1].AutoFilter
End With
End Sub
Но если у вас умная таблица, то и это не проканает.