Страницы: 1
RSS
Фильтрация сразу по нескольким столбцам по цвету текста.
 
Доброго времени всем.
Подскажите, возможно ли отфильтровать сразу по нескольким столбцам строки, в которых присутствуют значения выделенные красным шрифтом? Реальная таблица имеет бОльшее количество строк и столбцов, необходимо проанализировать данные нуждающиеся в уточнении, поэтому и желательно отобразить только красные, но все сразу. Понятно, что если в строке помимо красных значений будут отображены и черные, но хотелось бы скрыть те строки, в которых только черные значения. Ведение дополнительных столбцов с каким-либо маркером вместо выделения цветом очень нежелательно, т.к. их (доп. столбцов) потребуется значительное количество, и это усложнит таблицу.
 
cuprum, вариант выводить макросом на другой лист
Код
Sub mrshkei()
Dim i As Long, n As Long, lr As Long, lcol As Long, cell As Range
Worksheets("ОТБОР").Cells.Clear
lr = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lr
    For n = 6 To lcol
        If Cells(i, n).Font.ColorIndex <> 1 Then
            If cell Is Nothing Then
                Set cell = Cells(i, 1)
                Exit For
            Else
                Set cell = Union(cell, Cells(i, 1))
                Exit For
            End If
        End If
    Next n
Next i
Range(Cells(1, 1), Cells(1, lcol)).Copy Destination:=Worksheets("ОТБОР").Cells(1, 1)
If Not cell Is Nothing Then cell.EntireRow.Copy Destination:=Worksheets("ОТБОР").Cells(2, 1)
Worksheets("ОТБОР").Select
End Sub

Изменено: Mershik - 29.11.2020 19:12:32
Не бойтесь совершенства. Вам его не достичь.
 
cuprum, или просто скрыть
Код
Sub mrshkei()
Dim i As Long, n As Long, lr As Long, lcol As Long, cell As Range
lr = Cells(Rows.Count, 1).End(xlUp).Row
lcol = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 2 To lr
x = 0
    For n = 6 To lcol
        If Cells(i, n).Font.ColorIndex <> 1 Then
            x = x + 1
        End If
    Next n
        If x = 0 Then
            If cell Is Nothing Then
                Set cell = Cells(i, 1)
            Else
                Set cell = Union(cell, Cells(i, 1))
            End If
        End If
Next i
If Not cell Is Nothing Then cell.EntireRow.Hidden = True

End Sub
Не бойтесь совершенства. Вам его не достичь.
 
Mershik, спасибо, вариант со скрытием больше нравится, хотя... надо посмотреть, копирование на другой лист может тоже оказаться полезным.
 
Код
Sub filterRed()
    ActiveSheet.UsedRange.Offset(1).Resize(ActiveSheet.UsedRange.Rows.Count - 1).EntireRow.Hidden = True
    Application.FindFormat.Clear
    With Application.FindFormat.Font
'         Subscript = False
        .Color = 255
'        .TintAndShade = 0
    End With
    With ActiveSheet.UsedRange
    Set FindRes = .Find(What:="", After:=.Cells(1), LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
        If Not FindRes Is Nothing Then
           stAddress = FindRes.Address
        Do
           If FindRes.Rows.Hidden Then FindRes.EntireRow.Hidden = False
        Set FindRes = .Find(What:="", After:=FindRes, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True)
        Loop While Not FindRes Is Nothing And FindRes.Address <> stAddress
        End If
    End With
    Application.FindFormat.Clear
End Sub
Изменено: БМВ - 29.11.2020 21:25:44
По вопросам из тем форума, личку не читаю.
 
Чтобы сохранить автофильтр, можно добавить всего один один столбец к таблице и отразить в нем, например, число ячеек с красным шрифтом по строке. Столбец можно заполнять макросом или UDF-функцией, в обоих вариантах надо понимать, как именно (какими действиями) меняется цвет ячеек.
Владимир
 
БМВ, спасибо.

sokol92, цвет ячеек меняется вручную, при заполнении, данные вызывающие вопросы отмечаются красным, после снятия вопросов - авто/черный. Я подумаю над Вашим предложением про UDF. Спасибо.
 
Цитата
sokol92 написал:
или UDF-функцией
тут есть проблема с реакцией на раскрашивание, которой нет. Но в целом , пометить - это правильно. Можно помечать цветом в одном столбце и потом фильтровать автофильтром по нему.
Изменено: БМВ - 29.11.2020 21:28:10
По вопросам из тем форума, личку не читаю.
Страницы: 1
Наверх