▲▲検索欄を設置し該当する列を抽出する▲▲

質問

いつもお世話になっております。
マクロを学び始め、調べに調べたのですが、行き当たりました。
ご教授頂ければ幸いです。

タイトル通りで御座います。sheet1にフォームを作成し
それをsheet2に引っ張ることはできました。
続いて検索をさせたいのですが、それがうまくいきません。

写真を添付しているのですが、B2に検索したい文字を入力
※B2についてはセルでは無理かと思いますので、テキストボックスになるかと思います。
D2～D4のボタンを押すことで特定の部分から検索を行い
列を抽出しB10配下に該当するものを抽出したいのですが、全くうまくいきません。

ご教授頂ければ幸いです。

回答No.1

keithin · ベストアンサー

画像は小さくて見えませんし、具体的にＢ２の内容をどこからどのように探したいのかとか、３つのボタンのそれぞれ目的の機能も（要するに「何をどうしたい」のか）説明がありませんので、このままでは具体的なマクロのアドバイスも寄せられるハズもありませんね。

とりあえず、次の通りに作成してみます。

手順：
標準モジュールを用意、次の３つのマクロを用意する

sub macro1()
　if worksheets("Sheet3").range("B2") = "" then exit sub
　rows("11:9999").delete shift:=xlshiftup

’Ｂ２の内容をＢ列から前方後方一致で検索、転記する
　application.screenupdating = false
　application.calculation = xlcalculationmanual
　application.enableevents = false

　with worksheets("Sheet2")
　　.range("A:E").autofilter field:=2, criteria1:="*" & worksheets("Sheet3").range("B2").value & "*"
　　.autofilter.range.copy worksheets("Sheet3").range("B10")
　　.autofiltermode = false
　end with

　application.enableevents = true
　application.calculation = xlcalculationautomatic
　application.screenupdating = true
end sub

sub macro2()
　if worksheets("Sheet3").range("B2") = "" then exit sub
　rows("11:9999").delete shift:=xlshiftup

’Ｂ２の内容をＣ列から前方一致で検索、転記する
　application.screenupdating = false
　application.calculation = xlcalculationmanual
　application.enableevents = false

　with worksheets("Sheet2")
　　.range("A:E").autofilter field:=3, criteria1:=worksheets("Sheet3").range("B2").value & "*"
　　.autofilter.range.copy worksheets("Sheet3").range("B10")
　　.autofiltermode = false
　end with

　application.enableevents = true
　application.calculation = xlcalculationautomatic
　application.screenupdating = true
end sub

sub macro3()
　if worksheets("Sheet3").range("B2") = "" then exit sub
　rows("11:9999").delete shift:=xlshiftup

’Ｂ２の内容をＤ列から後方一致で検索、転記する
　application.screenupdating = false
　application.calculation = xlcalculationmanual
　application.enableevents = false

　with worksheets("Sheet2")
　　.range("A:E").autofilter field:=4, criteria1:="*" & worksheets("Sheet3").range("B2").value
　　.autofilter.range.copy worksheets("Sheet3").range("B10")
　　.autofiltermode = false
　end with

　application.enableevents = true
　application.calculation = xlcalculationautomatic
　application.screenupdating = true
end sub

ファイルメニューから終了してエクセルに戻る
フォーム（ＡｃｔｉｖｅＸコントロールでは無いので間違えない事）のコマンドボタン、若しくは図形等でボタン絵柄を作成、それぞれ右クリックしてマクロの登録で用意のマクロを登録して利用する。

お礼

お時間さいての回答に感謝します。
ココまで画像が小さくなっていると思いませんでした。
わかりにくい説明の中、的確な回答をありがとう御座います。

いただきましたマクロを調節してうまく動きました。
本当にありがとう御座います！

回答No.2

eden3616

Sub Macro1()
Sheets("Sheet2").Range("A5:C7").ClearContents
Sheets("Sheet1").Range("A1:C4").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Sheet2!Criteria"), CopyToRange:=Range( _
"Sheet2!Extract"), Unique:=False
End Sub

Sheet2（上記マクロ及びサンプル画像ではSheet1）のデータに対して
Sheet3（上記マクロ及びサンプル画像ではSheet2）に検索条件を入れて
Sheet3内に表示する方法として「詳細検索」機能をマクロ化する方法もあります

>B2についてはセルでは無理
「検索文字 = sheets("Sheet3").Range("B2").Value」という事では。

>D2～D4のボタン
謎です。添付画像では読みとることができませんでした。

>列を抽出しB10配下に
行ではなくて列を抽出ですか?

具体的にどのようにしたいのか読みとることができませんでしたので、
「返値 = worksheetfunction.match(検索文字,対象,一致モード)」で一致する行を探したり
For～Nextループで各セルを上記検索文字と一致するかIfで判定すればいいのでは。