|
こういうことかな?
違ったらごめん。
――――――――――――――――――――――――――――――
Dim wsSrch As Worksheet
Dim wsQuery As Worksheet
Dim sv As String
Dim rng As Range
Dim target As Range
Dim fstAddress As String
Dim v As String
Dim targetCol As Long
Set wsSrch = ActiveWorkbook.Worksheets("検索")
Set wsQuery = ActiveWorkbook.Worksheets("クエリ")
'検索結果値クリア
wsSrch.Range("D7").Value = ""
'検索値設定
sv = wsSrch.Range("D4").Value
If sv = "" Then
Exit Sub
End If
'出力対象列設定
targetCol = 4
'検索範囲
Set rng = wsQuery.Range("A1:D" & Range("A1").End(xlDown).Row)
'検索実行
Set target = rng.Find(sv)
If Not target Is Nothing Then
'初回一致セルアドレス
fstAddress = target.Address
'検索結果値取得
v = target.Offset(0, targetCol - target.Column).Value
Do
'次検索
Set target = rng.FindNext(target)
If target.Address = fstAddress Then
Exit Do
Else
'検索結果値結合
v = v & vbLf _
& target.Offset(0, targetCol - target.Column).Value
End If
Loop
End If
'検索結果値設定
wsSrch.Range("D7") = v
――――――――――――――――――――――――――――――
|
|