Tô màu nền cho tên sheet có điều kiện.

[nguyenquyetnd993]

Chào anh chị!

Nhờ anh chị giúp em vấn đề này vớiạ. Em muốn tô màu nền cho tên sheet theo điều kiện nếu ở cột E có xuất hiện ô màu đỏ (màu đỏ 255 em tô bàng Conditional Formatting) thì tên sheet cũng được bôi màu đỏ theo . và ngược lại nếu ở cột E không xuất hiện ô màu đỏ thì để trắng hoặc tô màu xanh. Dưới đây là file đính kèm của em.
Xin phép bổ sung: Nếu như không tô màu được thì có cách nào liệt kê các sheet mà cột E có ô màu đỏ không ạ.
Em cảm ơn!

 

[snow25]

Chào anh chị!

Nhờ anh chị giúp em vấn đề này vớiạ. Em muốn tô màu nền cho tên sheet theo điều kiện nếu ở cột E có xuất hiện ô màu đỏ (mã màu 255) thì tên sheet cũng được bôi màu đỏ theo . và ngược lại nếu ở cột E không xuất hiện ô màu đỏ thì để trắng hoặc tô màu xanh. Dưới đây là file đính kèm của em.
Xin phép bổ sung: Nếu như không tô màu được thì có cách nào liệt kê các sheet mà cột E có ô màu đỏ không ạ.
Em cảm ơn!

Bạn thử code này xem.

Sub tomau()
    Dim lr As Long, i As Long, dk As Boolean, k As Long
    For i = 3 To Sheets.Count
        dk = False
        With Sheets(i)
             lr = .Range("E" & Rows.Count).End(xlUp).Row
             If lr > 4 Then
                For k = 4 To lr
                    If .Cells(k, 5).Interior.ColorIndex = 40 Then
                       dk = True
                       Exit For
                    End If
                Next k
             End If
          If dk = False Then
             .Tab.ColorIndex = 40
          Else
             .Tab.ColorIndex = 3
          End If
       End With
   Next i
End Sub

 

[nguyenquyetnd993]

Bạn thử code này xem.

Sub tomau()
    Dim lr As Long, i As Long, dk As Boolean, k As Long
    For i = 3 To Sheets.Count
        dk = False
        With Sheets(i)
             lr = .Range("E" & Rows.Count).End(xlUp).Row
             If lr > 4 Then
                For k = 4 To lr
                    If .Cells(k, 5).Interior.ColorIndex = 40 Then
                       dk = True
                       Exit For
                    End If
                Next k
             End If
          If dk = False Then
             .Tab.ColorIndex = 40
          Else
             .Tab.ColorIndex = 3
          End If
       End With
   Next i
End Sub

Cảmơn anh đã giúp
Code tô chưa đúng anh ạ,
một số sheet cột E không có ô đỏ vẫn bị tô, có sheet cột E có ô đỏ lại không tô ạ.

 

[SA_DQ]

Thêm 1 tham khảo:

Sub SheetColor()
 Dim Sh As Worksheet, Rng As Range, Cls As Range
 
 Application.ScreenUpdating = False
 For Each Sh In ThisWorkbook.Worksheets
    ColorSheet Sh.Name, 2
    Set Rng = Sh.Range(Sh.[E1], Sh.[E65500].End(xlUp))
    For Each Cls In Rng
        If Cls.Interior.Color = 255 Then
            ColorSheet Sh.Name, 255:             Exit For
        End If
    Next Cls
 Next Sh
 Application.ScreenUpdating = True
End Sub

Sub ColorSheet(Sh, MyColor As Integer)
    With Sheets(Sh).Tab
        .Color = MyColor:                    .TintAndShade = 0
    End With
End Sub

 

[nguyenquyetnd993]

Thêm 1 tham khảo:

Sub SheetColor()
Dim Sh As Worksheet, Rng As Range, Cls As Range

Application.ScreenUpdating = False
For Each Sh In ThisWorkbook.Worksheets
    ColorSheet Sh.Name, 2
    Set Rng = Sh.Range(Sh.[E1], Sh.[E65500].End(xlUp))
    For Each Cls In Rng
        If Cls.Interior.Color = 255 Then
            ColorSheet Sh.Name, 255:             Exit For
        End If
    Next Cls
Next Sh
Application.ScreenUpdating = True
End Sub

Sub ColorSheet(Sh, MyColor As Integer)
    With Sheets(Sh).Tab
        .Color = MyColor:                    .TintAndShade = 0
    End With
End Sub

Code chạy không đúng ạ
em chạy xong tất cả các sheet đều bị bôi đen hết ạ

 

[snow25]

Thêm 1 tham khảo:

Sub SheetColor()
Dim Sh As Worksheet, Rng As Range, Cls As Range

Application.ScreenUpdating = False
For Each Sh In ThisWorkbook.Worksheets
    ColorSheet Sh.Name, 2
    Set Rng = Sh.Range(Sh.[E1], Sh.[E65500].End(xlUp))
    For Each Cls In Rng
        If Cls.Interior.Color = 255 Then
            ColorSheet Sh.Name, 255:             Exit For
        End If
    Next Cls
Next Sh
Application.ScreenUpdating = True
End Sub

Sub ColorSheet(Sh, MyColor As Integer)
    With Sheets(Sh).Tab
        .Color = MyColor:                    .TintAndShade = 0
    End With
End Sub

Bác Sa ơi code này nó khi tap sheet có màu đỏ mà trong cột E không có màu đỏ nó không chuyển màu vẫn thành màu đỏ à..

 

[nguyenquyetnd993]

Bác Sa ơi code này nó khi tap sheet có màu đỏ mà trong cột E không có màu đỏ nó không chuyển màu vẫn thành màu đỏ à..

Màu đỏ ở cột E là em dùng Conditional Formatting bôi. em xem thì nó là 255 không biết có đúng không nữa, code anh viết em thấy gần được rồi, a giúp em chỉnh lại được không ạ! em cảm ơn

 

[snow25]

Màu đỏ ở cột E là em dùng Conditional Formatting bôi. em xem thì nó là 255 không biết có đúng không nữa, code anh viết em thấy gần được rồi, a giúp em chỉnh lại được không ạ! em cảm ơn

Bạn xem nhé.

Sub tomau()
    Dim lr As Long, i As Long, dk As Boolean, k As Long
    For i = 3 To Sheets.Count
        dk = False
        With Sheets(i)
             lr = .Range("E" & Rows.Count).End(xlUp).Row
             If lr > 4 Then
                For k = 4 To lr
                    If Left(.Cells(k, 1), 4) = "3972" Then
                       If (.Cells(k, 6).Value - .Cells(k, 5).Value) > 0.01 Or (.Cells(k, 5).Value - .Cells(k, 6).Value) > 0.01 Then
                          dk = True
                          Exit For
                       End If
                    End If
                Next k
             End If
          If dk = False Then
             .Tab.ColorIndex = 40
          Else
             .Tab.ColorIndex = 3
          End If
       End With
   Next i
End Sub

 

[ThangCuAnh]

Color dùng trong Fill Color khác với color trong Conditional Formatting bạn. Sữa lại đi.
Code của các bác trên lấy theo color của Fill Color

 

[nguyenquyetnd993]

Bạn xem nhé.

Sub tomau()
    Dim lr As Long, i As Long, dk As Boolean, k As Long
    For i = 3 To Sheets.Count
        dk = False
        With Sheets(i)
             lr = .Range("E" & Rows.Count).End(xlUp).Row
             If lr > 4 Then
                For k = 4 To lr
                    If Left(.Cells(k, 1), 4) = "3972" Then
                       If (.Cells(k, 6).Value - .Cells(k, 5).Value) > 0.01 Or (.Cells(k, 5).Value - .Cells(k, 6).Value) > 0.01 Then
                          dk = True
                          Exit For
                       End If
                    End If
                Next k
             End If
          If dk = False Then
             .Tab.ColorIndex = 40
          Else
             .Tab.ColorIndex = 3
          End If
       End With
   Next i
End Sub

Vẫn bị lỗi anhơi ,Sheet 15S cần cần tô nhung code tô anhà

Bài đã được tự động gộp: 10/7/19

Vẫn bị lỗi anhơi ,Sheet 15S cần cần tô nhung code tô anhà

EM chỉnh được rồi cảm ơn anh nhiều

 

[Phuocam]

Hình như code lấy color trong Conditional Formatting là:

If .Cells(k, 5).DisplayFormat.Interior.ColorIndex = 40

 

[ThangCuAnh]

Mình dùng Excel 2007 nên chưa test cho chủ thớt được. Đúng là dùng Excel 2010 trở lên có thêm property DisplayFormat

I don't have an answer that works with Excel 2007 or lower but from Excel 2010 onwards you can use the following (changing the Range to suit):
Range("A1").DisplayFormat.Interior.ColorIndex

 

[nguyenquyetnd993]

Mình dùng Excel 2007 nên chưa test cho chủ thớt được. Đúng là dùng Excel 2010 trở lên có thêm property DisplayFormat

I don't have an answer that works with Excel 2007 or lower but from Excel 2010 onwards you can use the following (changing the Range to suit):
Range("A1").DisplayFormat.Interior.ColorIndex

Cảm ơn anh ,anh snow giúp mình xong rồi ạ

 

[ThangCuAnh]

Hì hì, đường nào cũng về La Mã, về được là tốt rồi. Dùng code của bạn snow thì chủ thớt không cần dùng Conditional Format nữa.
2 cái nó không có liên quan chút xíu gì tới nhau

 

[nguyenquyetnd993]

Hì hì, đường nào cũng về La Mã, về được là tốt rồi. Dùng code của bạn snow thì chủ thớt không cần dùng Conditional Format nữa.
2 cái nó không có liên quan chút xíu gì tới nhau

dạ, anh cho em hỏi, e viết 1 code cho 1 sheet giờ muốn chạy code đó cho toàn bộ sheet trong file thì pahir làm thế nào ạ?