Filter by font color tất cả các màu 1 lúc

[LanAnh19]

Chào các anh/chị và các bạn
Hiện nay em chỉ Filter by font color của từng màu,
Bây giở em muốn Filter by font color tất cả các màu 1 lần thì có cách nào không?
Em nhờ các anh/chị và các bạn viết code giúp đỡ, như file đính kèm
Em cảm ơn nhiều.

 

[bebo021999]

Bây giở em muốn Filter by font color tất cả các màu 1 lần thì có cách nào không?

Có chắc là muốn filter hết tất cả các màu không? Kể cả màu đen?
Nghĩa là không filter gì hết?

 

[LanAnh19]

Có chắc là muốn filter hết tất cả các màu không? Kể cả màu đen?
Nghĩa là không filter gì hết?

Em trình bày chưa rỏ ràng
Filter tất cả, trừ màu đen

 

[bebo021999]

OK, thử code này nhé

Option Explicit
Sub FilterColor()
Dim lr&, c&, cell As Range, ary()
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In Range("B5:B" & lr)
    If cell.Font.Color > 0 Then
        c = c + 1
        If c = 1 Then
            ReDim ary(1 To 1)
        Else
            ReDim Preserve ary(1 To UBound(ary) + 1)
        End If
        ary(UBound(ary)) = CStr(cell.Offset(, -1).Value)
    End If
Next
ActiveSheet.Range("A4:B" & lr).AutoFilter Field:=1, Criteria1:=ary, Operator:=xlFilterValues
End Sub

 

[LanAnh19]

OK, thử code này nhé

Option Explicit
Sub FilterColor()
Dim lr&, c&, cell As Range, ary()
lr = Cells(Rows.Count, "B").End(xlUp).Row
For Each cell In Range("B5:B" & lr)
    If cell.Font.Color > 0 Then
        c = c + 1
        If c = 1 Then
            ReDim ary(1 To 1)
        Else
            ReDim Preserve ary(1 To UBound(ary) + 1)
        End If
        ary(UBound(ary)) = CStr(cell.Offset(, -1).Value)
    End If
Next
ActiveSheet.Range("A4:B" & lr).AutoFilter Field:=1, Criteria1:=ary, Operator:=xlFilterValues
End Sub

Dạ em cảm ơn anh nhiều

 

[LanAnh19]

Code của bài #4 khi em đưa vào ứng dụng thì nó không chạy, không biết em sai chổ nào, nhờ anh chị hướng dẫn thêm
Trong file em đính kèm trong bài này, thì
sheet Data-2: không có dòng trống
sheet Data: có dòng trống
code cũng không chạy được ???!!!
Em xin cảm ơn!

 

[bebo021999]

Code tại #4: Căn cứ màu chữ cột B để lọc cột A (theo STT)
Bây giờ qua file mới thì cột STT vẫn còn mà không có số TT, làm sao code hoạt động được.
File này có phải là file sát với thực tế chưa? Cột STT thực tế nó là cái gì?
Bạn cho file sát với thực tế nhé.
Nếu thực tế cột này trống thì phải dùng cách khác: hide dòng, chứ không Filter.

 

[LanAnh19]

Code tại #4: Căn cứ màu chữ cột B để lọc cột A (theo STT)
Bây giờ qua file mới thì cột STT vẫn còn mà không có số TT, làm sao code hoạt động được.
File này có phải là file sát với thực tế chưa? Cột STT thực tế nó là cái gì?
Bạn cho file sát với thực tế nhé.
Nếu thực tế cột này trống thì phải dùng cách khác: hide dòng, chứ không Filter.

Em không biết code anh viết dựa vào cột STT
Bài thực tế của em giống sheet Data, trong đó có những dòng trống, còn cột STT thì nó có thể là số, là ký tự hoặc là ô trống
Em nhờ anh viết giúp em lại code, em cảm ơn nhiều
Xin lỗi đã làm phiền anh

 

[bebo021999]

Vậy không dùng Filter nữa.
Dùng lệnh hide các dòng có chữ tô màu
Muốn bỏ hide thì chuột phải, unhide dòng nhé.

Option Explicit
Sub FilterColor()
Dim lr&, cell As Range, u As Range
lr = Cells(Rows.Count, "B").End(xlUp).Row
Range("B5:B" & lr).EntireRow.Hidden = True
For Each cell In Range("B5:B" & lr)
    If cell.Font.Color > 0 Then
        If u Is Nothing Then
            Set u = cell
        Else
            Set u = Union(u, cell)
        End If
    End If
Next
u.EntireRow.Hidden = False
End Sub