| 
    
     |  | こんにちわ。 こう言う事かな?
 
 Sub Test()
 Dim Fi As Range, Ad As String, Ch As Boolean
 Ch = True
 With Worksheets("報告書")
 Set Fi = Worksheets("リスト").Columns(2).Find(.Range("AL2"), , xlValue, xlWhole)
 If Fi Is Nothing Then
 Ad = Fi.Address
 Do
 Set Fi = Worksheets("リスト").Columns(2).FindNext(Fi)
 If Fi.Offset(, 1).Text = .Range("l3").Text Then
 .Range("I4").Resize(3).Value = Application.Transpose(Fi.Offset(, 2).Resize(, 3).Value)
 .Range("I8").Value = Fi.Offset(, 5).Value
 .Range("I10").Value = Fi.Offset(, 6).Value
 Ch = False: Exit Do
 End If
 Loop Until Ad = Fi.Address
 Else
 GoTo End_Len
 End If
 End With
 If Ch Then GoTo End_Len
 Exit Sub
 
 End_Len:
 MsgBox "該当なし", vbInformation
 End Sub
 
 
 |  |