|
上の名無しはおいら。
で、以下のようなのでいいんじゃないかな?
アドレスはそちらにあわせて変更されてね。
Option Explicit
Sub test()
Dim buf
Dim Urng1 As Range, Urng2 As Range
Dim i As Long
Dim Uobj As Object
Dim fAd As String
Set Urng1 = Range("a1:a5")
Set Urng2 = Range("c1").CurrentRegion
buf = Urng1.Value
With Urng2
For i = 1 To UBound(buf)
Set Uobj = .Find(what:=buf(i, 1))
If Not Uobj Is Nothing Then
fAd = Uobj.Address
Do
Uobj.Interior.ColorIndex = 4
Set Uobj = .FindNext(Uobj)
If Uobj.Address = fAd Then Exit Do
Loop
End If
Next
End With
End Sub
|
|