longhoangtuan75
Thành viên chính thức


- Tham gia
- 22/4/16
- Bài viết
- 52
- Được thích
- 6
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 = 1 To Range("A1").End(xlToRight).Column
For j = 1 To Range("A1").End(xlDown).Row
kt = True: m = 0
Do While kt And (m < 10) And (j+m < Range("A1").End(xlDown).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 đỡ!
Sub GPE()
Dim i As Long, j As Long, m As Long, kt As Boolean
Application.ScreenUpdating = False
Cells.Interior.Pattern = xlNone
For i = 1 To Range("A1").End(xlToRight).Column
For j = 1 To Range("A1").End(xlDown).Row
kt = True: m = 0
Do While kt And (m < 10) And (j+m < Range("A1").End(xlDown).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 đỡ!