Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2016)
検索キーに合致した別シートの列を表示したい
投稿日時: 19/02/12 14:05:03
投稿者: SHIBARAKU

検索キーに合致した別シートの列を表示する方法をお教え下さい。
以下のsheet1に元となる表があります。
その表の検索番号をキーにsheet2で入力し、sheet2へ抽出する方法はありますか。
 
sheet1
年月日     コード1 検索番号 区分1 区分名
2019/1/2 12547 12564 12541 あああああ
2019/1/4 12897 35789 12541 あああああ
2019/1/5 12632 58947 12478 いいいいい
 
 
sheet2
 
検索番号 35789
 
年月日     コード1 検索番号 区分1 区分名
2019/1/4 12897 35789 12541 あああああ
 
 
以下のようなFindで検索しても検索番号しか持ってくることが出来ず、他の方法が
あれば良いのですが、
 
Sub 検索()
'
    Dim r As Range
    Dim t As Range
    Dim f As Range
    Dim i As Long
'
    With Worksheets("sheet1")
        Set t = .Range("C1", .Range("C" & Rows.Count).End(xlUp))
    End With
    i = 6
    With Worksheets("sheet2") '検索番号、結果シート
        For Each r In .Range("B3")
           Set f = t.Find(r.Value, t.Cells(t.Count, 1), xlValues, xlWhole, , xlNext)
            If Not f Is Nothing Then
               .Cells(i, 3) = f.Value
               i = i + 1
            End If
        Next
    End With
End Sub
 

回答
投稿日時: 19/02/12 16:12:26
投稿者: Suzu

フィルターオプションを使われては?
 
【フィルタオプションの抽出結果を別シートに表示する】
https://www.moug.net/tech/exopr/0040016.html

投稿日時: 19/02/15 10:23:37
投稿者: SHIBARAKU

Suzuさん 返答ありがとうございます。
フィルターオプション以外での方法はないでしょうか?
 

回答
投稿日時: 19/02/15 16:17:12
投稿者: current

シート2のB1セルに検索番号を入れることで、その列の情報が呼びだされます。
コード内のシート名を変数に書き直すことで他のシートにも転用できるように修正も可能です。
 

Sub Macro1()

a = 1
t = Worksheets(1).Cells(3, 1).End(xlDown).Row - 1

Worksheets(1).Select
Rows("1:1").Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste


For i = 1 To t
    Worksheets(1).Select
    If Worksheets(1).Cells(a, 3) = Worksheets(2).Range("B1") Then
    Rows(a & ":" & a).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A3").Select
    ActiveSheet.Paste
    Range("B5").Select
    Else
    a = a + 1
    End If
Next i

End Sub

回答
投稿日時: 19/02/15 17:11:30
投稿者: Suzu

Find を使用するなら Find を使用しても良いと思いますよ。
 
転記を行っているのは
 
 .Cells(i, 3) = f.Value
 
これでは、1セルのみです。
 
 A列から指定したいのであれば
 .Cells(i, 1) = f.Offset(0,-2).Value
 .Cells(i, 2) = f.Offset(0,-1).Value
 .Cells(i, 3) = f.Offset(0, 0).Value
   :
 の様になるのでは?
 
 このあたりはコピペを使えば
 
f.Offset(0, -2).Resize(1, 5).Copy
.Cells(i, 1).PasteSpecial
 
で書き換える事が可能。
 
あとは、Find 単独では、該当する値のセルが取得できる。
そのあと続けて検索が必要なら FindNextが必要ですね。helpで確認ください。

投稿日時: 19/02/18 13:50:23
投稿者: SHIBARAKU

Suzuさん、currentさん
ありがとうございます。
意図した内容で抽出できました。
 
また、別質問になるのですが、以下のSheet1のように検索番号に同じ番号が
存在した場合、一番最後の列を抽出する事はできますか?
 
sheet1
年月日 コード1 検索番号 区分1 区分名
2019/1/2 12547 12564 12541 あああああ
2019/1/4 12897 35789 12541 あああああ
2019/1/5 12632 58947 12478 いいいいい
2019/1/6 12547 12564 12541 いいいいい
  
sheet2
  
検索番号 12564
  
年月日 コード1 検索番号 区分1 区分名
2019/1/6 12547 12564 12541 いいいいい
 
FindNextとDo Loopを組み合わせれば可能なのでしょうか?

回答
投稿日時: 19/02/18 17:02:06
投稿者: 虎

検索番号の重複がある場合、一番下のデータを優先するのであれば、
Findの検索の向きを下からに変えて、一番初めに見つかったデータを返せばいいと思います。
 
こちらのサイトが参考になると思います(^^)
https://www.relief.jp/docs/excel-vba-find-from-bottom.html

投稿日時: 19/02/19 11:03:11
投稿者: SHIBARAKU

虎さん、ありがとうございます。
抽出できました。