Sub ss()
Dim arr
Dim rng As Range
Dim i&, k&, s&
arr = Sheet1.Range("P1:P" & Sheet1.Cells(Rows.Count, "P").End(xlUp).Row)
Sheet1.UsedRange.Offset(1).Interior.ColorIndex = ""
For i = UBound(arr) To 2 Step -1
If InStr(arr(i, 1), "清洁") + InStr(arr(i, 1), "办公") + InStr(arr(i, 1), "纸") + InStr(arr(i, 1), "清洗") > 0 Then
If Cells(i, 1).MergeCells = True Then
k = Cells(i, 1).MergeArea.Row
s = Cells(i, 1).MergeArea.Rows.Count
If rng Is Nothing Then Set rng = Sheet1.Cells(k, 1).Resize(s, 16) Else Set rng = Union(rng, Sheet1.Cells(k, 1).Resize(s, 16))
i = k
Else
If rng Is Nothing Then Set rng = Sheet1.Cells(i, 1).Resize(1, 16) Else Set rng = Union(rng, Sheet1.Cells(i, 1).Resize(1, 16))
End If
End If
Next
rng.Interior.ColorIndex = 20
End Sub
|