|
ichinose さん ブライト さん
こんにちは。
かき回してみました。
Sub fidss()
Dim SahR As Range, Cel As Range, FCL As Range, SavAd As String
Dim SahSt As String
Set SahR = Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A65536").End(xlUp))
With Sheets("Sheet2")
For Each Cel In SahR
SahSt = Cel.Value
Set FCL = .Columns(1).Find(SahSt, After:=.Range("A65536"), LookAt:=xlWhole, MatchCase:=True)
If Not FCL Is Nothing Then
SavAd = FCL.Address
Do
SahSt = FCL.Offset(, 1).Value
Set FCL = .Columns(1).Find(SahSt, After:=FCL, LookAt:=xlWhole, MatchCase:=True)
If FCL Is Nothing Then Exit Do
Loop Until FCL.Address = SavAd
Cel.Offset(, 1).Value = SahSt
End If
Next
End With
End Sub
|
|