Здравствуйте. Не подскажете как скрыть строку в используемом диапазоне (UsedRange) во всех ячейках которой отсутствует заливка. Другими словами если есть хоть одна залитая ячейка в используемом диапазоне строку скрывать не нужно.
Макрос
Sub макрос()
Dim i As Long
'1. Отключение монитора, чтобы ускорить макрос.
Application.ScreenUpdating = False
'2. Скрытие строк, в которых нет заливки.
For i = 1 To ActiveSheet.UsedRange.Rows.Count
If ActiveSheet.UsedRange.Rows(i).Interior.Color = 16777215 Then
ActiveSheet.UsedRange.Rows(i).Hidden = True
End If
Next i
'3. Вкл. монитора.
Application.ScreenUpdating = True
'4. Сообщение, чтобы юзер понял, что макрос закончил работу.
MsgBox "Готово.", vbInformation
End Sub
Спасибо. все работает.
Я добавил еще вот такой код в ваш после "Next i".
Код
For Each Cell In ActiveSheet.UsedRange
Cells.Find("Директор").EntireRow.Hidden = False
Exit For
On Error Resume Next
Next Cell
For Each Cell In ActiveSheet.UsedRange
Cells.Find("__").EntireRow.Hidden = False
Exit For
Next Cell
For Each Cell In ActiveSheet.UsedRange
Cells.Find("г").EntireRow.Hidden = False
Exit For
Next Cell
For Each Cell In ActiveSheet.UsedRange
Cells.Find("труба").EntireRow.Hidden = False
Exit For
Next Cell
For Each Cell In ActiveSheet.UsedRange
Cells.Find("норм").EntireRow.Hidden = False
Exit For
Next Cell
For Each Cell In ActiveSheet.UsedRange
Cells.Find("Инженер").EntireRow.Hidden = False
Exit For
Next Cell
Для того чтобы отобразил в любом случае строки со словами "Директор, утверждаю, норм, труба" и другими.
И все работает если эти слова встречаются в файле. Но если какого-то слова нет выдает ошибку. Например если в файле стоит не "директор", а "управляющий". Я добавил оператор On Error Resume Next, но все равно выдает ошибку 91. Как от нее избавиться? Может есть лучше способ как не скрывать строки даже если все ячейки в них не залиты, но содержат определенные слова. Эти слова являются частью содержимого ячейки т.е. пытаться завязаться на Value, мне кажется не получится, нужно пробовать через Find.
Здесь две процедуры. Поместите их в один модуль. Запускайте процедуру "Макрос", вторая процедура будет запускаться процедурой "Макрос".
В процедуре "Макрос", в пункте 2 запишите фразы, которые надо искать.
Макрос
Sub макрос()
Dim phrases As Collection
Dim i As Long
'1. Отключение монитора, чтобы ускорить макрос.
Application.ScreenUpdating = False
'2. Запишите в коллекцию фразы, которые надо искать.
Set phrases = New Collection
phrases.Add Item:="__"
phrases.Add Item:="г"
'3. Скрытие строк, в которых нет заливки.
For i = 1 To ActiveSheet.UsedRange.Rows.Count
' Поиск в строке текста. Если текст есть, то скрывать строку не надо,
' даже если в строке нет заливки.
' Если искомой фразы нет.
If HasPhrase(phrases, ActiveSheet.UsedRange.Rows(i)) = False Then
' Просмотр заливки.
If ActiveSheet.UsedRange.Rows(i).Interior.Color = 16777215 Then
ActiveSheet.UsedRange.Rows(i).Hidden = True
End If
End If
Next i
'4. Вкл. монитора.
Application.ScreenUpdating = True
'5. Сообщение, чтобы юзер понял, что макрос закончил работу.
MsgBox "Готово.", vbInformation
End Sub
Private Function HasPhrase(phrases As Collection, row As Range) As Boolean
Dim i As Long
' Поиск в строке фразы. Для поиска используется эксель-функция "СЧЕТЕСЛИ".
For i = 1 To phrases.Count
If WorksheetFunction.CountIf(row, phrases(i)) <> 0 Then
HasPhrase = True
Exit Function
End If
Next i
End Function
Получается что макрос ищет только ячейки в которых эти фразы содержатся целиком и только они.
Например Строка не скроется если в ячейке содержится только слово "Директор", а если "Директор ЗАО" то скроется. нужно как-то искать по части содержания ячейки. Не могу разобраться как.
Вот так нужно искать фразы не целиком:
phrases.Add Item:="*__*"
То есть нужно использовать в функции "СЧЕТЕСЛИ" подстановочный символ "*". Его можно подставить в эти позиции:
1) в начало искомой фразы;
2) в конец;
3) в начало и конец;
4) внутри фразы.
Этот символ означает ноль или любое кол-во любых символов.
Спасибо.