Option Explicit: Option Base 1
Dim Rng9 As Range: Dim bXh As Byte, bDem As Byte
Sub ToMau()
ReDim MSo(2500) As Byte: Dim yY As Long
2 Dim Rng As Range, Clls As Range
Dim iJ As Integer, Xx As Integer
4 For Each Rng In Range("B2:AY51")
iJ = iJ + 1
6 yY = Rng.Row: Xx = Rng.Column
If yY = 2 And Xx = 2 Then 'O Tren Trai Nhat'
8 Set Rng9 = Union(Rng.Resize(2, 2), Cells(yY, 51).Resize(2, 1), _
Cells(51, 2).Resize(1, 2), Cells(51, 51))
10 Color9 Rng9: Set Rng9 = Nothing
MSo(iJ) = bXh Mod 2: bXh = 0
12 ElseIf yY = 2 And Xx = 51 Then 'O Tren Phai Nhat'
Set Rng9 = Union(Cells(2, 2).Resize(2, 1), Cells(2, 50).Resize(2, 2), _
Cells(51, 2), Cells(51, 50).Resize(1, 2))
14 Color9 Rng9: Set Rng9 = Nothing
MSo(iJ) = bXh Mod 2: bXh = 0
16 ElseIf yY = 51 And Xx = 2 Then 'O Duoi Trai Nhat'
Set Rng9 = Union(Cells(2, 2).Resize(1, 2), Cells(2, 51), _
Cells(50, 2).Resize(2, 2), Cells(50, 51).Resize(2, 1))
18 Color9 Rng9: Set Rng9 = Nothing
MSo(iJ) = bXh Mod 2: bXh = 0
20 ElseIf yY = 51 And Xx = 51 Then 'O Duoi Phai Nhat'
Set Rng9 = Union(Cells(2, 2), Cells(2, 50).Resize(1, 2), _
Cells(50, 2).Resize(2, 1), Cells(50, 50).Resize(2, 2))
22 Color9 Rng9: Set Rng9 = Nothing
MSo(iJ) = bXh Mod 2: bXh = 0
24 ElseIf yY = 2 Then 'Cac O Con Lai Cua Cot 'B''
Color9 Union(Rng.Offset(, -1).Resize(2, 3), Rng.Offset(49, -1).Resize(1, 3))
26 MSo(iJ) = bXh Mod 2: bXh = 0
ElseIf Xx = 2 Then 'Cac O Con Lai Cua Dong '2''
28 Color9 Union(Rng.Offset(-1).Resize(3, 2), Rng.Offset(-1, 49).Resize(3, 1))
MSo(iJ) = bXh Mod 2: bXh = 0
30 ElseIf Xx = 51 Then 'Cac O Con Lai Cua Cot Cuoi'
Color9 Union(Rng.Offset(-1, -49).Resize(3, 1), Rng.Offset(-1, -1).Resize(3, 2))
32 MSo(iJ) = bXh Mod 2: bXh = 0
ElseIf yY = 51 Then 'Cac O Con Lai Cua Hang Cuoi'
34 Color9 Union(Rng.Offset(-49, -1).Resize(1, 3), Rng.Offset(-1, -1).Resize(2, 3))
MSo(iJ) = bXh Mod 2: bXh = 0
36 Else '2.500-198 O Con Lai'
Color9 Rng.Offset(-1, -1).Resize(3, 3)
38 MSo(iJ) = bXh Mod 2: bXh = 0
End If
40 Next Rng
iJ = 0
42 For Each Rng In Range("B2:AY51")
iJ = 1 + iJ
44 Rng.Interior.ColorIndex = IIf(MSo(iJ) = 1, 5, 0) '3'
Next Rng
46 bDem = bDem + 1: [A1].Select
[A1] = bDem
End Sub
