Giúp sửa code: Tô màu Font Color theo nhiều điều kiện! (2 người xem)

Hong.Van · 12/1/13

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
[GPECODE=vb]Sub ToMau()
Dim i As Long
Dim arrRes, arrSrc
With ActiveSheet
arrSrc = .Range(.[A9], .[A65536].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

[/GPECODE]

ndu96081631 · 12/1/13

Hong.Van đã viết:
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
[GPECODE=vb]Sub ToMau()
Dim i As Long
Dim arrRes, arrSrc
With ActiveSheet
arrSrc = .Range(.[A9], .[A65536].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

[/GPECODE]

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:

Mã:

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

Quang_Hải · 12/1/13

Hong.Van đã viết:
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 !
-----------

Thử thêm code này nhé

PHP:

Sub color_format()
Dim i, Arr()
[K9:K10000].Font.ColorIndex = 1
Arr = Range([A9], [A65536].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

Hong.Van · 12/1/13

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

PHP:

=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!

ndu96081631 · 12/1/13

Hong.Van đã viết:
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!

Hong.Van · 12/1/13

ndu96081631 đã viết:
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!

ndu96081631 · 12/1/13

Hong.Van đã viết:
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...

Quang_Hải · 12/1/13

Hong.Van đã viết:
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 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ử.

Quang_Hải · 12/1/13

Như đã hứa, mình gởi code nông dân lên cho bạn cày thử nhé

PHP:

Sub color_again()
Dim data(), i As Long, ngaydau As Date, ngaycuoi As Date, temp As Date
ngaydau = Sheets("MA").[A3]: ngaycuoi = Sheets("MA").[B3]
data = Range([B9], [B65536].End(3)).Value
[B9:B1000].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?

ndu96081631 · 13/1/13

quanghai1969 đã viết:
Như đã hứa, mình gởi code nông dân lên cho bạn cày thử nhé

Mã:

Sub color_again() .................... If temp < ngaydau Or temp > ngaycuoi _ Or temp < [COLOR=#ff0000][B]Application.Max[/B][/COLOR](Range(Cells(8, 2), Cells(i + 7, 2))) Then Cells(i + 8, 2).Font.ColorIndex = 3 End If ................... 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?
Ẹc... Ẹc...

Quang_Hải · 13/1/13

ndu96081631 đã viết:
Bài này nếu không dùng Application.Max thì làm thế nào đây?
Ẹc... Ẹc...

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.

PHP:

Sub color_again2()
Dim data(), i As Long, ngaydau As Date, ngaycuoi As Date, temp As Date, Smax
ngaydau = Sheets("MA").[A3]: ngaycuoi = Sheets("MA").[B3]
data = Range([B9], [B65536].End(3)).Value
[B9:B1000].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

Giúp sửa code: Tô màu Font Color theo nhiều điều kiện! (2 người xem)

Người dùng đang xem chủ đề này

Hong.Van

Busy

File đính kèm

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

Hong.Van

Busy

File đính kèm

ndu96081631

Huyền thoại GPE

Hong.Van

Busy

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

Quang_Hải

Thành viên gạo cội

ndu96081631

Huyền thoại GPE

Quang_Hải

Thành viên gạo cội

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian