|
こんにちは
これで如何かな?
Private Sub ken_Click()
Dim adrs As String, addr As Range
Dim theadd As String, R As Range
adrs = adr.Value
Application.ScreenUpdating = False
With Worksheets("一覧")
Set addr = .Range("a1:c35000").Find(adrs, , xlValues, xlPart)
If Not addr Is Nothing Then
theadd = addr.Address
Set R = addr
Do
Set addr = .Range("a1:c35000").FindNext(addr)
Set R = Union(R, addr)
Loop Until theadd = addr.Address
MsgBox "見つかりました。"
.Activate
R.Activate
Else
MsgBox "該当なし"
End If
End With
Application.ScreenUpdating = True
Set R = Nothing: Set addr = Nothing
End Sub
|
|