Option Explicit
Sub ColourMatchingCells()
With Thism Tab2range as range
'Replace Sheet2 below with whatever Tab 2 is named -- and A1:A50 with actual range address.'
Set Tab2range = .worksheets("Sheet2).range("A1:A50")
Dim cell as range
' Again, replace Sheet1 name and range address on next line with actual values'
With .worksheets("Sheet1").range("A1:K1000")
Dim AddressOfFirstMatch as string
Dim CellFound as range
Dim MatchAddress as string
For each cell in Tab2range
' Case insensitive search and which tries to find the whole value. You did not mention what type of data you're searching for e.g. strings, numbers, dates, etc. -- or what type of search you want. '
Set CellFound = .cells.find(what:=cell.value2,lookin:=xlvalues,lookat:=xlwhole,searchdirection:=xlnext,Matchcase:=False)
If not (CellFound is nothing) then
AddressOfFirstMatch = CellFound.address
CellFound.interior.color = vbblue 'just an example'
Do
Set CellFound = .findnext(CellFound)
CellFound.interior.color = vbblue
MatchAddress = CellFound.address
Doevents ' If you experience infinite loop or bad logic, spam/hold Escape or Break key on keyboard'
Loop until strcomp(AddressOfFirstMatch,MatchAddress, vbbinarycompare) = 0
End if
Next cell
End with
End with
End Sub
1 回答
如果您不提供代码或屏幕截图，很难回答 .
它有用吗？它能做你想要的吗？