|
Sub test()
On Error Resume Next
Set Rng = Nothing
For Each rn In [a1:u321]
If rn.Interior.ColorIndex = 6 Then
w = 0
For j = -1 To 1
If rn.Offset(-1, j).Interior.ColorIndex = 6 Then
w = w + 1
End If
If rn.Offset(1, j).Interior.ColorIndex = 6 Then
w = w + 1
End If
If rn.Offset(0, j).Interior.ColorIndex = 6 Then
If j <> 0 Then w = w + 1
End If
Next j
If w >= 4 Then
If Rng Is Nothing Then
Set Rng = rn
Else
Set Rng = Union(Rng, rn)
End If
End If
End If
Next rn
If Not Rng Is Nothing Then Rng.Interior.ColorIndex = 3
End Sub
|
评分
-
1
查看全部评分
-
|