Tô màu cho ô dữ liệu có điều kiện!

[hcl_pt]

Mình có bảng dữ liệu mong GPE giúp đỡ, vấn đề như sau: Tô màu vào ô dữ liệu chỉ đứng trước 2 ô chứa dữ liệu liên tiếp có ở trong hàng và tính là điểm 1 vào dòng ĐIỂM có cột chứa ô được tô màu.
Xin chân thành cảm ơn!
(Mình có làm ví dụ cho vài trường hợp trong file gửi minh hoạ)

 

[gtri]

Mình có bảng dữ liệu mong GPE giúp đỡ, vấn đề như sau: Tô màu vào ô dữ liệu chỉ đứng trước 2 ô chứa dữ liệu liên tiếp có ở trong hàng và tính là điểm 1 vào dòng ĐIỂM có cột chứa ô được tô màu.
Xin chân thành cảm ơn!
(Mình có làm ví dụ cho vài trường hợp trong file gửi minh hoạ)

1 cột có 2 ô màu vàng vẫn tính là 1 điểm?

 

[johnnylinhanh]

Bạn xem file dưới đây đúng ý của bạn chưa?

 

[hcl_pt]

Bạn xem file dưới đây đúng ý của bạn chưa?

Cảm ơn bạn đã quan tâm! Bạn ơi, chỉ tô màu cho ô có chứa dữ liệu đứng trước hai ô chứa dữ liệu liên tiếp, còn ô chứa dữ liệu mà đứng trước 3 hay 4 ô chứa dữ liệu trở lên thì không được tính tô màu. Một cột mà có nhiều ô được tô màu vẫn được tính 1 điểm ạ!

 

[gtri]

Cảm ơn bạn đã quan tâm! Bạn ơi, chỉ tô màu cho ô có chứa dữ liệu đứng trước hai ô chứa dữ liệu liên tiếp, còn ô chứa dữ liệu mà đứng trước 3 hay 4 ô chứa dữ liệu trở lên thì không được tính tô màu. Một cột mà có nhiều ô được tô màu vẫn được tính 1 điểm ạ!

Chạy thử đoạn code này xem sao
Nhấn vào cái ghi chú màu xanh của bạn

Public Sub To_Mau()
Dim DL As Range, r As Long, c As Long

With Sheet1
r = .Range("E1000000").End(xlUp).Row
c = .Range("XFD1").End(xlToLeft).Column + 1

.Range(.Cells(4, 7), .Cells(r, c)).ClearFormats
.Range(.Cells(r, 7), .Cells(r, c)).ClearContents
Set DL = .Range(.Cells(4, 7), .Cells(r, c))

For r = 1 To DL.Rows.Count - 1
For c = DL.Columns.Count To 4 Step -1
If DL(r, c) = "" And DL(r, c - 1) <> "" And DL(r, c - 2) <> "" And DL(r, c - 3) <> "" Then
DL(r, c - 3).Interior.ColorIndex = 3
DL(DL.Rows.Count, c - 3) = 1
End If
Next c
Next r

End With
End Sub

 

[hcl_pt]

Chạy thử đoạn code này xem sao
Nhấn vào cái ghi chú màu xanh của bạn

Public Sub To_Mau()
Dim DL As Range, r As Long, c As Long

With Sheet1
r = .Range("E1000000").End(xlUp).Row
c = .Range("XFD1").End(xlToLeft).Column + 1

.Range(.Cells(4, 7), .Cells(r, c)).ClearFormats
.Range(.Cells(r, 7), .Cells(r, c)).ClearContents
Set DL = .Range(.Cells(4, 7), .Cells(r, c))

For r = 1 To DL.Rows.Count - 1
For c = DL.Columns.Count To 4 Step -1
If DL(r, c) = "" And DL(r, c - 1) <> "" And DL(r, c - 2) <> "" And DL(r, c - 3) <> "" Then
DL(r, c - 3).Interior.ColorIndex = 3
DL(DL.Rows.Count, c - 3) = 1
End If
Next c
Next r

End With
End Sub

Vâng, cảm ơn bạn nhiều! Đúng như yêu cầu bạn ạ! Rất tuyệt!