いずれかの条件を含むデータを全て抽出したい

質問

シート1(ここに貼り付ける)に元データを貼り付けたら、シート2、シート3に必要なデータを自動で抽出出来るような関数を組みたいです。
シート1のD列の商品名の中に「標準」か「キャリブ」いずれかの文字を含むものはシート2に。「染色」か「マルチ」いずれかの文字を含むものでB列が「血液検査」のものはシート3に。というように条件を複数指定して、該当するものは丸々抽出したいです。どなたか分かる方教えてください。よろしくお願い致します！

この投稿のマルチメディアは削除されているためご覧いただけません。

回答No.5

SI299792 · ベストアンサー

言葉の通り、Ｉ列を使うという意味ですが。
実物を見た方が早い。
Ｉ列は見る必要がない数字なので、非表示にしてあります。

https://1drv.ms/x/s!AnfEM367OeSdhyoHe7CtXhp_IADk?e=HQQ7AB

補足

シート2のI列に関数をいれて、その後にシート2のA列にまた関数を入れるということですね！挑戦してみます！ありがとうございます^ ^

回答No.4

HohoPapa

VBAを持ち込んでいいのであれば、
（SQL文も使うので若干ハードルが上がりますが）
後記コードはいかがでしょうか？

"ここに貼り付ける"というシートから
"Sheet2"、"Sheet3"というシートに出力しています。

抽出条件は、SQL文を見てもらえばおおよそ推測できると思います。
また、列名の末尾に「.(ドット)」が使われているので
出力先列名で文字化けが起きるかもしれません。
その場合は指摘してください。
コードを修正します。

よかったら挑戦してみてください。

Option Explicit

Sub sample()
　Dim SQL As String
　Dim cn As Object
　Dim rs As Object
　Dim i As Long

　'Sheet2に抽出==============

　'SQL全文を組み立て
　SQL = ""
　SQL = SQL & "SELECT *" & vbCrLf
　SQL = SQL & "FROM [" & "ここに貼り付ける" & "$A1:Z50000]" & vbCrLf
　SQL = SQL & "WHERE (([商品名] LIKE '%標準%') or " & vbCrLf
　SQL = SQL & " ([商品名] LIKE '%キャリブ%')) " & vbCrLf

　'SQLを実行
　Set cn = CreateObject("ADODB.Connection")
　Set rs = CreateObject("ADODB.Recordset")
　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
　cn.Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1"
　cn.Open ThisWorkbook.Path & "\" & ThisWorkbook.Name
　rs.Open SQL, cn

　'結果セットを出力
　With ThisWorkbook.Sheets("Sheet2")　　'出力先シートの指定
　　.Cells.ClearContents '出力先クリアー
　　For i = 0 To (rs.Fields.Count - 1) '列名を出力
　　　.Cells(1, i + 1).Value = rs.Fields(i).Name
　　Next
　　.Cells(2, 1).CopyFromRecordset rs
　End With

　'後処理
　rs.Close
　Set rs = Nothing
　cn.Close
　Set cn = Nothing

　'Sheet3に抽出==============

　'SQL全文を組み立て
　SQL = ""
　SQL = SQL & "SELECT *" & vbCrLf
　SQL = SQL & "FROM [" & "ここに貼り付ける" & "$A1:Z50000]" & vbCrLf
　SQL = SQL & "WHERE (([商品名] LIKE '%染色%') or " & vbCrLf
　SQL = SQL & " ([商品名] LIKE '%マルチ%')) and " & vbCrLf
　SQL = SQL & " ([在庫部署] = '血液検査') " & vbCrLf

　'SQLを実行
　Set cn = CreateObject("ADODB.Connection")
　Set rs = CreateObject("ADODB.Recordset")
　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
　cn.Properties("Extended Properties") = "Excel 12.0;HDR=Yes;IMEX=1"
　cn.Open ThisWorkbook.Path & "\" & ThisWorkbook.Name
　rs.Open SQL, cn

　'結果セットを出力
　With ThisWorkbook.Sheets("Sheet3")　'出力先シートの指定
　　.Cells.ClearContents '出力先クリアー
　　For i = 0 To (rs.Fields.Count - 1) '列名を出力
　　　.Cells(1, i + 1).Value = rs.Fields(i).Name
　　Next
　　.Cells(2, 1).CopyFromRecordset rs
　End With

　'後処理
　rs.Close
　Set rs = Nothing
　cn.Close
　Set cn = Nothing

End Sub

補足

回答ありがとうございます！
最初はマクロで作成していたのですが、途中うまくいかず関数でも作成していました。
マクロ使用可ですので挑戦してみます。ありがとうございます！^ ^

回答No.3

msMike

確認させてください。
》 シート1のD列の商品名の中に「標準」か
》 「キャリブ」いずれかの文字を含むものは…

貴方の添付図のD列には、「標準」も「キャリブ」のいずれも存在しないのはどういう理由なんですか？
よく「アレは単なる例なので…」などと居直る質問者がいますが、貴方もそのクチですか？
それから、『B列が「血液検査」のものは…』などと記してるけど、B列全部が「血液検査」なのは質問用としては不適切とは思いませんか？

何れにしても「…というように条件を複数指定して、該当するものは丸々抽出したい」回答が不可能と言わざるを得ません。

「該当するものは丸々抽出した」例を示してくださいナっ！

補足

返答ありがとうございます！
実際には1000行以上ありまして、画像には映り込んでいませんが、標準もキャリブも存在します！B列は実際には血液検査以外に3種類あります。説明しやすい単語を選んだつもりなのですが、すみません。

回答No.2

imogasi

参考にしてください。
エクセルのシートのデータで、条件に合うものを抜出したい、という質問は多い。ここでも、３か月に１回ぐらい出る。
基本は、エクセルでは、文字列指定の条件による、抽出は
（１）操作の、フィルタでやる。
　　　ただし、データが増減して、変わったら、再度やり直し、という欠点がある。
（２）エクセル関数では、データ内容による、条件による抜出は、式が複雑になって
　　　難しいのだ。
（３）最近のエクセル・バージョンでは、FILTER関数が新設され、様子が変わった。
　　質問にエクセル・バージョンも書かないものは、こういうことも知らないのだろう。
（４）FILTER関数を使わない（使えない）場合、
　　（２）も中間作業列を使うと、すこし理解しやすい方法になる。
　　　しかし、今まで、初心者らしい質問者ででも（１）や、「関数を使うが、中間作業列を使うこと」を　　　　　　　　　好まない者が多いようだ。また関数・関数という者が多いようだ。
＝＝＝＝
付けたしで、
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/prog/prog04.html
を参考にして、
参考にVBAでやったものを挙げてみる。内容は簡略化してある。
前もって、シート名が「リンゴ」、「柿」、「なし」、「ぶどう」、「オレンジ」のシートを、操作で作っておく。
これもVBAでも、できるが、今回は略。
例データ（元データ）
シート名は「データ」A1:B10
品物 個数　＜ーー見出し行
リンゴ 1
柿 2
なし 3
ぶどう 4
オレンジ 5
ぶどう 6
柿 7
ぶどう 8
リンゴ 9
柿 10
ーーー
標準モジュールに
Sub test02()
'品物（個別）名のシート以外のシー名のシートは、存在させないこと｡
Dim myFld As String
Dim myCri As String
Dim myRow As Long
For Each sh In Worksheets
'Worksheets("データ").Range("A1").AutoFilter
myFld = 1 'InputBox("検索は何列目ですか?")　本例ではＡ列の品物名で探す
myCri = sh.Name 'InputBox("検索する語句を入力しなさい")　本例ではシート名でＡ列を探す
MsgBox myCri
'オートフィルタでデータを抽出する
Worksheets("データ").Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri
'抽出データの最終行を求める
myRow = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row
MsgBox myRow
'抽出先シートの範囲ををクリアする
'Worksheets(myCri).Columns("A：B").ClearContents 'A,B列データクリア
'抽出した結果データをコピーして、品物シートに貼り付け
Worksheets("データ").Range("A1:B" & myRow).Copy Worksheets(myCri).Range("A1")
'「データ」シートのオートフィルタを解除
Worksheets("データ").Range("A1").AutoFilter
'抽出先シートをアクティブにしてA1セルを選択する
'Worksheets(myCri).Activate
'Range("A1").Select
Next
End Sub
ーーー
実行の結果
「リンゴ」シートは、
品物 個数
リンゴ 1
リンゴ 9
他の「品物」のシートは、実行結果を見てください。
＝＝
こういうデータベース的な処理では関数でやる（FILTER関数以外で）のは古い。非能率的。
新しいバージョンのエクセルで使えるようになった、PowerQuery機能などを勉強すべきかと思う。

補足

返答ありがとうございます。
VBAも試してはみたのですが、作業が複雑でうまくいきませんでした。
ありがとうございました！

回答No.1

SI299792

バージョンが解りません。

最新版（Excel2021 OneDreve）
Sheet2
A2: =FILTER(ここに貼り付ける!A:H,1-ISERROR(FIND("標準",ここに貼り付ける!D:D))*ISERROR(FIND("キャリブ",ここに貼り付ける!D:D)))

Sheet3
A2: =FILTER(ここに貼り付ける!A:H,(1-ISERROR(FIND("血液検査",ここに貼り付ける!B:B)))*(1-ISERROR(FIND("染色",ここに貼り付ける!D:D))*ISERROR(FIND("マルチ",ここに貼り付ける!D:D))))

旧バージョン、Ｉ列をワークエリアに使います。データ件数分必要です。目障りなら非表示にして下さい。
Sheet2
I2: =I1+COUNTIF(ここに貼り付ける!D2,"*標準*")+COUNTIF(ここに貼り付ける!D2,"*キャリブ*")
下へコピペ。

Sheet3
I2: =I1+COUNTIF(ここに貼り付ける!B2,"*血液検査*")*(COUNTIF(ここに貼り付ける!D2,"*染色*")+COUNTIF(ここに貼り付ける!D2,"*マルチ*"))
下へコピペ。

共通
A2: =IFERROR(INDEX(ここに貼り付ける!A:A,MATCH(ROW()-1,$I:$I,0)),"")
右下へコピペ。

補足

回答ありがとうございます！
旧バージョンなのですが、I列を使用するというのはどのようにしたらいいのでしょうか？
理解不足ですみません(＞＜)