Nhờ các bạn sửa giúp code tìm kiếm theo định dạng.

[longhoangtuan75]

Các bạn giúp mình sửa lại code này với, xin cảm ơn các bạn!

Sub GPE()
Dim i As Long, j As Long, m As Long, kt As Boolean
Application.ScreenUpdating = False
Cells.Interior.Pattern = xlNone
For i = 3 To Range("C25").End(xlToRight).Column
For j = 25 To Range("C65000").End(xlUp).Row
kt = True: m = 0
Do While kt And (m < 10) And (m + j < Range("C65000").End(xlUp).Row)
m = m + 1
If (Cells(j + m, i).Font.Bold = False) Or (Cells(j + m - 1, i).Font.Bold = False) _
And (Cells(j + m, i).Font.ColorIndex <> xlAutomatic) Or (Cells(j + m - 1, i).Font.ColorIndex <> xlAutomatic) Then
kt = False
End If
Loop
If m = 10 And kt Then Cells(j, i).Resize(10).Interior.Color = 5296274
Next j
Next i
Application.ScreenUpdating = True
End Sub

Code này bạn Giaiphap viết giúp mình. Nó tìm và tô mầu nền cho chuỗi ô theo cột có cùng định dạng đen đậm. ( như phần A của file đính kèm.)

Mình muốn sửa lại để nó tìm và tô mầu nền cho chuỗi ô theo cột có cùng định dạng đỏ đậm. ( như phần B của file đính kèm.)

Rất mong các bạn giúp đỡ!



'

 

[VetMini]

. . . . . . . . . .
. . . . .

 

[bebo021999]

Nếu bạn mô tả lại từ đầu thì tốt nhất. Còn không thì thay dòng này:

And (Cells(j + m, i).Font.ColorIndex <> xlAutomatic) Or (Cells(j + m - 1, i).Font.ColorIndex <> xlAutomatic) Then

thành :

And (Cells(j + m, i).Font.Color <> vbRed) Or (Cells(j + m - 1, i).Font.Color <> vbRed) Then

 

[longhoangtuan75]

Nếu bạn mô tả lại từ đầu thì tốt nhất. Còn không thì thay dòng này:

And (Cells(j + m, i).Font.ColorIndex <> xlAutomatic) Or (Cells(j + m - 1, i).Font.ColorIndex <> xlAutomatic) Then

thành :

And (Cells(j + m, i).Font.Color <> vbRed) Or (Cells(j + m - 1, i).Font.Color <> vbRed) Then

Chào bạn!
Cảm ơn bạn rất nhiều vì đã giúp mình thành công.
Chúc bạn nhiều sức khỏe và thành đạt!!!