|
楼主 |
发表于 2022-5-31 21:52
|
显示全部楼层
本帖最后由 t2019er 于 2022-5-31 21:57 编辑
我自己尝试着写到,实现到第三步,第四部下不去l
Sub test()
Dim I As Integer
Dim j As Integer
Dim k As Integer
Dim s As Integer
Dim r As Integer
Dim lastrow As Integer
For I = 2 To 200 'sheets(i)子表名
For j = 2 To 200 'sheets(1)A列查样品编号
If Sheets(I).Cells(3, "h") = Sheets(1).Cells(j, "a") Then
Sheets(1).Cells(j, "c") = "存在"
Sheets(1).Cells(j, "c").Interior.ColorIndex = 6
For k = 21 To 2000 Step 18 ' sheets(i)子表查项目
If IsError(Application.Find(Sheets(1).Cells(j, "b"), Sheets(I).Cells(k, "a"), 1)) Then ' sheets(i)子表项目不在Sheets(i).Cells(k, "a")
Else
'sheets(i)子表项目在Sheets(i).Cells(k, "a")时高亮
Sheets(I).Cells(k, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 1, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 2, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 3, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 4, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 5, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 6, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 7, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 8, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 9, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 10, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k - 11, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k + 1, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k + 2, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k + 3, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k + 4, "a").Interior.ColorIndex = 6
Sheets(I).Cells(k + 5, "a").Interior.ColorIndex = 6
Sheets(I).Cells(1, "a").Interior.ColorIndex = 6
Sheets(I).Cells(2, "a").Interior.ColorIndex = 6
Sheets(I).Cells(3, "a").Interior.ColorIndex = 6
Sheets(I).Cells(4, "a").Interior.ColorIndex = 6
Sheets(I).Cells(5, "a").Interior.ColorIndex = 6
Sheets(I).Cells(6, "a").Interior.ColorIndex = 6
Sheets(I).Cells(7, "a").Interior.ColorIndex = 6
Sheets(I).Cells(8, "a").Interior.ColorIndex = 6
Sheets(1).Cells(j, "d") = "存在"
End If
Next
Else
End If
Next
Next
End Sub
|
|