Giúp sửa code: Tô màu Font Color theo nhiều điều kiện!

Chia sẻ bởi:hands

★★★★★

‹ Giúp sửa code: Fương thức Find để... Giúp viết code: Cộng dồn, trừ dồn... ›

Quảng cáo

Em chào Thấy cô & anh chị!
Do File thực tế của em rất nhiều dữ liệu cần Conditional Formatting, vì quá nhiều nên File nặng & chậm, vì thế em muốn viết code Tô màu Font Color theo nhiều điều kiện, như sau:

Em xin lấy dòng thứ 9 làm ví dụ với các điều kiện:
1/ Nếu LEFT(A9)="N" và H9=1561 và LEFT(K9)="H" thì K9 tô chữ màu xanh
2/ Nếu LEFT(A9)="X" và I9=1561 và LEFT(K9)="H" thì K9 tô chữ màu xanh
3/ Nếu LEFT(A9)="N" và H9=152 và LEFT(K9)="L" thì K9 tô chữ màu xanh
4/ Nếu LEFT(A9)="X" và I9=152 và LEFT(K9)="L" thì K9 tô chữ màu xanh

Tương tự cho các dòng sau
Mong được giúp code MẪU để em có thể áp dụng cho nhiều trường hợp khác
Em muốn code trên Module để em chạy kết hợp với nhiều code khác
Em cảm ơn !
———–
Code của em như sau
Sub ToMau()
Dim i As Long
Dim arrRes, arrSrc
With ActiveSheet
arrSrc = .Range(., ..End(3)).Resize(, 11).Value
End With
ReDim arrRes(1 To UBound(arrSrc, 1), 1 To 1)
For i = 1 To UBound(arrSrc, 1)
If Left(arrSrc(i, 1), 1) = "N" And arrSrc(i, 8) = 1561 And Left(arrSrc(i, 11), 1) = "H" Then arrRes(i, 1).Font.ColorIndex = 5
If Left(arrSrc(i, 1), 1) = "X" And arrSrc(i, 9) = 1561 And Left(arrSrc(i, 11), 1) = "H" Then arrRes(i, 1).Font.ColorIndex = 5
If Left(arrSrc(i, 1), 1) = "N" And arrSrc(i, 8) = 152 And Left(arrSrc(i, 11), 1) = "L" Then arrRes(i, 1).Font.ColorIndex = 5
If Left(arrSrc(i, 1), 1) = "X" And arrSrc(i, 9) = 152 And Left(arrSrc(i, 11), 1) = "L" Then arrRes(i, 1).Font.ColorIndex = 5
Next i
ActiveSheet.Range("K9").Resize(UBound(arrRes, 1)).Value = arrRes
End Sub

Việc tô màu chỉ có thể thực hiện trực tiếp trên Range mà thôi… thế nên câu lệnh arrRes(i, 1).Font.ColorIndex = 5 là sai hoàn toàn
Sửa lại:

Sub ToMau()
  Dim i As Long
  Dim bChk1 As Boolean, bChk2 As Boolean, bChk3 As Boolean, bChk4 As Boolean
  Dim arrRes, arrSrc, rng As Range
  Set rng = Range([A9], [A65536].End(3)).Resize(, 11)
  arrSrc = rng.Value
  For i = 1 To UBound(arrSrc, 1)
    bChk1 = (Left(arrSrc(i, 1), 1) = "N") And (arrSrc(i, 8) = 1561) And (Left(arrSrc(i, 11), 1) = "H")
    bChk2 = (Left(arrSrc(i, 1), 1) = "X") And (arrSrc(i, 9) = 1561) And (Left(arrSrc(i, 11), 1) = "H")
    bChk3 = (Left(arrSrc(i, 1), 1) = "N") And (arrSrc(i, 8) = 152) And (Left(arrSrc(i, 11), 1) = "L")
    bChk4 = (Left(arrSrc(i, 1), 1) = "X") And (arrSrc(i, 9) = 152) And (Left(arrSrc(i, 11), 1) = "L")
    If bChk1 Or bChk2 Or bChk3 Or bChk4 Then
      rng(i, 11).Font.ColorIndex = 5
    Else
      rng(i, 11).Font.ColorIndex = 0
    End If
  Next i
End Sub

www.giaiphapexcel.com/diendan/threads/gi%C3%BAp-s%E1%BB%ADa-code-t%C3%B4-m%C3%A0u-font-color-theo-nhi%E1%BB%81u-%C4%91i%E1%BB%81u-ki%E1%BB%87n.76148/

Thử thêm code này nhé

Sub color_format()
Dim i, Arr()
.Font.ColorIndex = 1
Arr = Range(, .End(3)).Resize(, 11).Value
For i = 1 To UBound(Arr)
If Left(Arr(i, 11), 1) = "H" Or Left(Arr(i, 11), 1) = "L" Then
If Left(Arr(i, 1), 1) = "N" Then
If Arr(i, 8) = 1561 Or Arr(i, 8) = 152 Then
Cells(i + 8, 11).Font.ColorIndex = 5
End If
ElseIf Left(Arr(i, 1), 1) = "X" Then
If Arr(i, 9) = 1561 Or Arr(i, 9) = 152 Then
Cells(i + 8, 11).Font.ColorIndex = 5
End If
End If
End If
Next
End Sub

Em cảm ơn các Thầy và anh!
Em còn 1 trường hợp này chưa xử lý được như sau:
Em muốn thay C.Formatting cho cột ngày (cột B) của Sheet TH như sau:
Công thức trong C.F như sau
=OR($B9<NgayDau;$B9<MAX($B$8:$B8);$B9>NgayCuoi)
Trong đó: NgayDau là Name tại cell A3 của Sheet MA. NgayCuoi là Name tại cell B3 của Sheet MA
Vì dữ liệu của em có hàng trống nên fải dùng hàm Max
———-
Em chưa xử lý được vì code không hỗ trợ hàm Max và … chưa nghĩ ra vì dữ liệu bắt đầu từ dòng thứ 9 mà điều kiện lại liên quan đến dòng thứ 8!
Em cảm ơn!

Cùng lắm bạn dùng WorksheetFunction.Max cũng được vậy!

Em vẫn chưa hình dung được! Nhờ các Thầy & anh làm mẫu cho em 1 cái để em làm theo (chứ kg fải em làm biếng đâu)
Em cảm ơn!

Cũng giống như hôm trước bạn làm với WorksheetFunction.SumIf đấy thôi. Nói chung trên bảng tính dùng thế nào thì trong code dùng như vậy… Cái điều kiện trong CF ta đưa vào code để làm điều kiện kiểm tra, nếu đúng thì tô màu, ngược lại thì cho màu đen
——————-
Cố gắng trước đi, chừng nào.. NHỨC ĐẦU thì anh quanghai sẽ cho dầu.. TRƯỜNG SƠN
Ẹc.. Ẹc…

Công thức mần được thì chắc chắn code mần được mà. Cố lên nhé. Cứ ra đk từng dòng code thì code sẽ nghe lời thôi.
Nếu không được thì tối rảnh mình xem thử.
Như đã hứa, mình gởi code nông dân lên cho bạn cày thử nhé

Sub color_again()
Dim data(), i As Long, ngaydau As Date, ngaycuoi As Date, temp As Date
ngaydau = Sheets("MA").: ngaycuoi = Sheets("MA").
data = Range(, .End(3)).Value
.Font.ColorIndex = 1
For i = 1 To UBound(data)
If data(i, 1) <> "" Then
temp = data(i, 1)
If temp < ngaydau Or temp > ngaycuoi _
Or temp < Application.Max(Range(Cells(8, 2), Cells(i + 7, 2))) Then
Cells(i + 8, 2).Font.ColorIndex = 3
End If
End If
Next
End Sub

PS: Bạn nhìn kỹ xem code giống y chang công thức của bạn bên ngoài sheet đúng không?

Bài này nếu không dùng Application.Max thì làm thế nào đây?

Chắc mần thế này phải không anh? Thật ra trong code em cũng muốn hạn chế dùng WorksheetFunction
Những điều mà các bậc anh chị đố thì luôn rất hay và ngắn gọn đáng để mọi người học hỏi.
Anh có cách giải hay hơn hãy trình diễn cho mọi người xem đi anh.

Sub color_again2()
Dim data(), i As Long, ngaydau As Date, ngaycuoi As Date, temp As Date, Smax
ngaydau = Sheets("MA").: ngaycuoi = Sheets("MA").
data = Range(, .End(3)).Value
.Font.ColorIndex = 1
For i = 1 To UBound(data)
If data(i, 1) <> "" Then
Smax = IIf(Smax > data(i, 1), Smax, data(i, 1))
temp = data(i, 1)
If temp < ngaydau Or temp > ngaycuoi Or temp < Smax Then
Cells(i + 8, 2).Font.ColorIndex = 3
End If
End If
Next
End Sub