Excelの質問です。2つの条件のどちらかを満たすデータを抽出し、別シートにデータを移したいです。

質問

こんばんは。以前の質問でも、データの抽出に関して教えていただいた者です。皆様の優しさに頼りっきりです。
今回は2つ以上の条件でデータを抽出したいと思ったのですが・・・なかなかスマートなやり方が浮かびませんでして(>_<)
今、手元には『名言.xls』というファイルがあります。
シートには名前をつけていません。(Sheet1,Sheet2・・・)といった感じになっています。

Sheet1のA列とB列には、以下のようなデータが入っています。

A列--------B列

sa-1--------若木に腰掛けな
ar-1--------毎日少しずつ。それがなかなかできねんだなあ。（相田みつを）
sp-1--------「がんばれ、がんばれ」という人がいるより、僕は、「できないでくれ」という人がいる方が熱くなる。(イチロー)
sa-2--------骨肉相食む
ar-2--------お前自身を知ろうとするならば、いかに他の人々が行動するかを観察せよ。お前が他の人々を理解しようとするならば、お前自身の心を見よ。(シラー『書き板』)
ac1--------仕事は来た順。だってそれが誠意でしょ。(哀川翔)

というように、A列には番号、B列には名言のデータが、ズラリと入っています。
sa-(＝ことわざ)、ar-(＝芸術家・思想家)、sp-(＝スポーツ選手)、ac(＝俳優)といった感じです。

この一覧のデータの中から、A列が「sa-*(ワイルドカード)」あるいは「ar-*」という、2つの条件のどちらかを満たした場合、そのセルの隣にあるB列のデータを抽出し、Sheet2のA列に、抽出したデータを並べたいのです。

皆様の英知をお借しください(>_<)
よろしくお願いします<m(__)m>

回答No.9

merlionXX · ベストアンサー

No6 merlionXXです。

> "sa-*"または"ar-*"に一致するすべてのデータではなく、A列の中で1番最初に来るデータ(sa-1)がある行のB列のデータのみが、Sheet2に移動したのです。

No6のコードをそのままコピペして試しましたが、そのような現象を再現できません。
もしわたしが回答したコードでそのようなことがおきるとすれば、

１．A列のデータがA１以外から始まっており、A1からデータまでの間に空白がある。
２．A列の途中に空白行があり、そこまでの間では該当するデータがその１つしかなかった。
３．該当するデータがその１つしかなかった。
４．コードの 　i = i + 1　が i = 1 に書き洩れている。

のどれかが原因だと思います。
多分、１か２の可能性が高いと思われますので、その場合でも大丈夫なコードを回答します。

Sub test02()
With Sheets("Sheet1")
For Each c In .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
If c.Value Like "sa-*" Or c.Value Like "ar-*" Then
i = i + 1
Sheets("Sheet2").Cells(i, "A").Value = c.Offset(0, 1).Value
End If
Next
End With
End Sub

お礼

原因は「2」でした、さすがですね、恐るべき洞察力です(゜ロ゜)
曖昧な質問をしてしまってすいません(>_<)
実は空白のセルも結構あったんですよね・・・(^_^;)

で、実行してみたところ、うまくいきました！
ありがとうございます<m(__)m>
3つ以上の条件も、

If c.Value Like "sa-*" Or c.Value Like "ar-*" Then

を、

If c.Value Like "sa-*" Or c.Value Like "ar-*" Or "ac-*" Then

に変えることで対応できました(≧▽≦)ゞ

回答No.11

n-jun

＃８のn-junです。

＞A列にはA1からsa-1、ar1・・・などの番号が、B列にはB1から名言が、ちゃんと入ってます。
Ａ１には”番号”・Ｂ１には”名言”の項目行が必要となります。
データはＡ２・Ｂ２以下にお願いします。

お礼

うまくいきました！
ありがとうございます(>_<)
A列とD列の項目行の名称は、同じにしなければならないんですね、いやはや勉強になります(^_^;)
実はD列は、皆さんの指導を実施していく中で埋まってしまったのですが、

Set　r　=　.Range(.Range("D1"),　.Cells(Rows.Count,　4).End(xlUp))

を、

Set　r　=　.Range(.Range("I1"),　.Cells(Rows.Count,　9).End(xlUp))

等に変えると、全然問題なく、Sheet2にデータがズラリと並びました！
何度も回答していただき本当にありがとうございます<m(__)m>

回答No.10

imogasi

#7です。
条件に合う行に連番を振るのは
=IF(OR(A2="sa",A2="ar"),MAX($D$1:D1)+1,"")
を入れて最終行まで式複写すればよい。
Find関数など使いません。
ただし質問の例を私は私のシートにコピーし、データー区切り位置ー区切り文字を「その他」のハイフンでやると、saと１が別列になりました。実際はどうですか。saと1が別列に分かれないなら
=IF(OR(LEFT(A2,2)="sa",LEFT(A2,2)="ar"),MAX($D$1:D1)+1,"")
で、連番がD列に出来ると思います。条件に合わない行はD列は空白です。

お礼

実はA列に振られている番号は、非常に混沌しておりまして(^_^;)

「sa-1」が「ar-1」のように、間にハイフンがあるものもあれば、「ac1」のように、ハイフンがないものもあり、データをうまく区切ることはできませんでした・・・なので、imogasiさんが2つめに挙げてくださった、

=IF(OR(LEFT(A2,2)="sa",LEFT(A2,2)="ar"),MAX($D$1:D1)+1,"")

を実行してみたところ、うまくいきました！
OR関数とLEFT関数を組み合わせるんですね、しかも2つだけでなく、3つ4つ・・・と、条件が追加できるんですね！

LEFT(A2,1)="t"とか、LEFT(A2,5)="other"とか、OR関数とLEFT関数を組み合わせれば、複雑な条件でも抽出することができそうです、ほんとありがとうございます<m(__)m>

ただ、ここからどうするかなのですが、抽出した番号はなぜか、連番ではなく、全て「1」なのです。

=IF(OR(LEFT(A2,2)="sa",LEFT(A2,2)="ar"),MAX($D$1:D1)+1,"")

をC列に入れてオートフィルすると、「A列にsaがあるB列のデータ」「A列にarがあるB列のデータ」に、「1」が振られました・・・連番ではなかったです。

でも「このまま突っ走ても大丈夫だろう」と思い、そのままSheet2に行き、imogasiさんが書いてくださったコード、

=INDEX(Sheet1!$A$1:$C$100,MATCH(ROW()-1,Sheet1!$D$1:$D$100,0),COLUMN())

を、「D列は使わなかったのでこんな感じかな」と思い、

=INDEX(Sheet1!$A$1:$B$100,MATCH(ROW()-1,Sheet1!$C$1:$C$100,0),COLUMN())

と書きかえて、C2までオートフィルし、そして下方へオートフィルしたところ、全部「#N/A」になってしまいました・・・(;_;)

回答No.8

n-jun

n-junです。

＞3つ以上の条件を指定することは、できないのでしょうか？

Ｄ列が未入力列としています。
Ｄ１に検索項目”番号”を入力します。
Ｄ２以下に　sa-* , ar-* , ac-*　を入力します。
あとはAdvancedFilterで、

Sub　try2()
　Dim　r　As　Range

　With　Worksheets("Sheet1")
　　　　　　If　.Range("D2").Value　=　""　Then　Exit　Sub

　　　　　　Application.ScreenUpdating　=　False

　　　　　　Set　r　=　.Range(.Range("D1"),　.Cells(Rows.Count,　4).End(xlUp))
　　　　　　.Range("A:B").AdvancedFilter　xlFilterInPlace,　r
　　　　　　If　.Cells(Rows.Count,　2).End(xlUp).Row　>　1　Then
　　　　　　　　　.Range(.Range("B1"),　.Cells(Rows.Count,　2).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy　_
　　　　　　　　　Worksheets("Sheet2").Range("A1")
　　　　　　End　If
　　　　　　.ShowAllData

　　　　　　Application.ScreenUpdating　=　True
　End　With
　Set　r　=　Nothing
End　Sub

と言う感じでしょうか？

お礼

マクロを実行してみたのですが、何も起きません・・・(ToT)
おかしいですね。
AdvancedFilterというのは初めて知りました！さっそく、D1には“番号”という文字を入力し、D2、D3、D4にはそれぞれsa-*、ar-*、ac-*と入力したのですが・・・C列には何も入ってませんが、A列にはA1からsa-1、ar1・・・などの番号が、B列にはB1から名言が、ちゃんと入ってます。
シートの名前も、何もいじっていないのですが(>_<)

回答No.7

imogasi

#4です。連番は視認してふるのでなく、関数（の複写）で振ります。
私の書いた関数式をじっくり読み直してください。
複写も＋ハンドルで５００行引っ張らなくても、他に少し楽な方法もあります。ある列Aで範囲指定（A1:A500)しておいて、A1に式を入れてCRTL+ENTERなど。範囲指定は、例　A1クリック+SHIFT＋名前ボックスにA500＋ENTERで範囲指定。

お礼

imogasiさんの回答をじっくり読みなおし、「まずはC列にFIND関数でsa,arを探す→ISERROR関数で有無の判別をしよう！」と思い、C列に

=FIND(sa,A1,1)

と入力し、オートフィルしたところ、saのあるものだけに1という番号が振られました！
そして、「どうせならsaとar、2つの条件のいずれかを満たすセルに番号を振ろう」と思い、

=FIND("sa"or"ar",A1,1)

と入力したところ・・・「入力された数式は正しくありません」と、エラー表示されてしまいました(ToT)
FIND関数では、ココ↓
http://ohpa.net/modules/xlnote/content0166.html
に記載されているように、複数の列を使用しなければ、「saかarのいずれかを満たす」等の、2つ以上の条件でデータを抽出することはできないのでしょうか？

回答No.6

merlionXX

先日回答した
http://okwave.jp/qa5020652.html　
とちがうのは貼り付け先が他のシートになることと、OR条件だということだけのようですね。
とりあえず回答はしますが、次回は、ある程度ご自分でもコードをお書きになり、それでわからない部分を質問するようになっていただければうれしいです。

Sub test01()
With Sheets("Sheet1")
For Each c In .Range(.Range("A1"), .Range("A1").End(xlDown))
If c.Value Like "sa-*" Or c.Value Like "ar-*" Then
i = i + 1
Sheets("Sheet2").Cells(i, "A").Value = c.Offset(0, 1).Value
End If
Next
End With
End Sub

お礼

そうですよね、いつもmerlionXXさんに甘えてばかりでは成長しませんよね・・・肝に銘じます(>_<)
いつものように、merlionXXさんのマクロを実行してみたところ、Sheet2にポツンと、1個だけデータが移りました。

"sa-*"または"ar-*"に一致するすべてのデータではなく、A列の中で1番最初に来るデータ(sa-1)がある行のB列のデータのみが、Sheet2に移動したのです。

ここから自分の力でmerlionXXさんのマクロに手を加えるべきなのですが・・・やはりマクロは難しく、どこを書きかえればいいのやら(;_;)

merlionXXさんは、どうやってマクロを勉強したのですか？学校ですか？独学ですか？仕事上必要に迫られてですか？何かお勧めの参考書はありますか？

と、ほんと図々しいですよね、いつもお世話になっているので、また甘えてしまいました(笑)
全然、無視してくださって結構です。
お暇な時に、またご指導よろしくお願いします(^_^;)

回答No.5

KURUMITO

マクロでなくとも関数で対応できますね。
二つの条件はSheet1のＣ1とＤ1セルにそれぞれ入力するとして、番号はＡ2セルから下方に、名言はＢ2セルから下方にそれぞれデータが入力されるとします。
Ｃ2セルには次の式を入力し下方にオートフィルドラッグします。
=IF($A2="","",IF(ISERROR(FIND(C$1,$A2)),"",MAX(C$1:C1)+1))
Ｄ2セルには次の式を入力し下方にオートフィルドラッグします。
=IF($A2="","",IF(ISERROR(FIND(D$1,$A2)),"",MAX(C:C,D$1:D1)+1))
Sheet2ではA2セルから下方に名言を並べるとしてA2セルには次の式を入力して下方にオートフィルドラッグします。
=IF(COUNTIF(Sheet1!C:C,ROW(A1))>0,INDIRECT("Sheet1!B"&MATCH(ROW(A1),Sheet1!C:C)),IF(COUNTIF(Sheet1!D:D,ROW(A1))>0,INDIRECT("Sheet1!B"&MATCH(ROW(A1),Sheet1!D:D)),""))
以上で完成です。
マクロではデータを表示するたびに操作が必要でしょうが、ここではＣ1セルとＤ1セルに検索のキーワードを入力することで対応できますし、データが追加された場合にも即座に対応できるメリットがあります。

お礼

できました！すごい方法ですね、驚きです。
C1セルに入れた文字列が、A列にあるか比較して、一致すると、順番に番号を振ってくれました！さらに驚いたのは、D1に2つめの条件を入れると、1番からではなく、C列の最後の番号の続きから番号が振られました！
関数に秘密があるみたいですね(^_^;)
Sheet2の方も上手くいきました。KURUMITOさんが記述してくださった関数をオートフィルすると、番号と同じ行にあるB列のデータが、ずらりと並びました。こんな方法があるんですね。
ただ、私にとって新鮮で高度で複雑な関数でしたので、じっくり仕組みの方も検討してみたいと思います。
ありがとうございました(>_<)

回答No.4

imogasi

VBAの回答が続いているが、質問者はVBAがわかるのかな。多分経験ないだろう。コピーして結果だけ出ればよいのかな。
ーー
自称「imogasi方式」で出来そうです。
データー区切り位置ー（区切り文字）その他「－」ー重複した区切り文字は１文字として扱う、で
A列 B列 C列
sa 1 若木に腰掛けな・・
ar 1 毎日少しずつ。そ・・
sp 1 「がんばれ、がん・・
sa 2 骨肉相食む
ar 2 お前自身を知ろう・・
ac 1 仕事は来た順。だ・・
のように分けられた。
ただ質問の例の書き方(特にー）が実際かどうかはっきりしないので
不安有るが。
記号列と番号列が分けられないのが実情なら、A列（次号＋番号が有る）についてFIND関数でsa,arを探す。後は書きimogasi方式が使える。sa,arが見つかるかどうかは、Find関数の結果をISERROR関数で判別すればよい（関数のネスト、組み合わせ）。その場合ワールドカードは使わない。行っていることわかるかな。
ーーー
するとA列がsaかarであれば抜き出せばよい。それにはどちらかであれば、うえの行から、連番を振っていく。
D2に式　=IF(OR(A2="sa",A2="ar"),MAX($D$1:D1)+1,"")を入れて最終行まで式複写。
結果
A列 B列 C列 　　　D列＝ワーク列
sa 1 若木に腰掛けな 1
ar 1 毎日少しずつ。そ 2
sp 1 「がんばれ、がん
sa 2 骨肉相食む 3
ar 2 お前自身を知ろう 4
ac 1 仕事は来た順。だ
ーーー
Sheet2に行って
A2に
=INDEX(Sheet1!$A$1:$C$100,MATCH(ROW()-1,Sheet1!$D$1:$D$100,0),COLUMN())
C2まで式複写。
次にA2:C2の式を、「Sheet1のD列の最大数」の行数＋１まで式複写。
結果
Sheet2A-C列
番号
sa 1 若木に腰掛けな・・
ar 1 毎日少しずつ。そ・・
sa 2 骨肉相食む
ar 2 お前自身を知ろう・・
「（条件付き）抜き出し問題」の色々な解決方法は、Googleで「imogasi方式」で照会すれば、過去質問が相当数出てきて、他の回答者の色々なやり方が有ることが実感できよう。

お礼

回答ありがとうございます！
imogasi方式を実践しようと思ったのですが、最初の「連番を振る」という段階で躓いてしまいまして・・・
実はデータが膨大(1500行ほど)ですので、saとarのあるものを視認しながら番号を振っていくのは、ものすごく時間がかかってしまうのです(>_<)
この状況を打開することはできないでしょうか？

回答No.3

tom04

こんにちは！
的外れの回答かもしれませんが・・・

オートフィルタのオプションを使う方法はどうでしょうか？

↓の画像のようにオートフィルタの設定をした後、
オートフィルタのオプションの抽出条件設定画面で
「sa*」と「等しい」　→　or　「ar*」と「等しい」
又は
「sa」を「含む」　or　「ar」を「含む」としてOK

これで「sa」と「ar」が含まれる行だけ表示されますので
そのB列を範囲指定してSheet2のA列に貼り付けます。

以上、当方使用のExcel2003での回答です。
この程度の回答しか出来ませんが、参考にならなかったら
読み流してくださいね。m(__)m

お礼

全然そんなことありません、画像まで添付していただいてすいません(>_<)
スマートなやり方だと思うのですが、条件が2つまでしか指定できないようでして・・・実は「sa*」or「ar*」or「ac-*」という風に、3つ以上の条件でも抽出したいのです(^_^;)
でも、tom04さんのアドバイスでひらめきました。最初に＜「sa*」or「ar*」に等しい＞でデータを抽出して、次に＜「ac-*」に等しい＞で抽出して、最後に一つにまとめればいいんですよね！
どうもありがとうございます！

回答No.2

n-jun

シート１の１行目には項目行があり、シート２のＡ１以下に貼付けるとしたら、

Sub try()
　With Worksheets("Sheet1")
　　　　　.Range("A1").AutoFilter 1, "sa-*", xlOr, "ar-*"
　　　　　.Range(.Range("B2"), .Cells(Rows.Count, 2).End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
　　　　　Worksheets("Sheet2").Range("A1")
　　　　　.AutoFilterMode = False
　End With
End Sub

と言う感じでしょうか？

お礼

うまくできました！
ありがとうございます(>_<)
ただ、条件が3つ4つとなると、うまくできませんでして・・・n-junさんのコードを参考に、

Range("A1").AutoFilter 1, "sa-*", xlOr, "ar-*"

を、

Range("A1").AutoFilter 1, "sa-*", xlOr, "ar-*" xlOr, "ac-*"

と、or条件を増やして抽出しようと試みたのですが、うまくいかなかったです、構文エラーみたいなのが表示されてしまいました(ToT)
3つ以上の条件を指定することは、できないのでしょうか？
図々しくてすいません、無視していただいても構いませんので、お気の向いた際にでもお答いただければ幸いです。

回答No.1

taka108

Sub test()
Dim pv As String
Worksheets("Sheet2").Activate
Range("a1").Select
Worksheets("Sheet1").Activate
Range("a1").Select
Do Until Selection.Value = ""
If Left(Selection.Value, 2) = "sa" Then
pv = Selection.Cells(1, 2).Value
Worksheets("Sheet2").Activate
Selection.Value = pv
Selection.Cells(2, 1).Select
End If
Worksheets("Sheet1").Activate
Selection.Cells(2, 1).Select
Loop
End Sub

お礼

実行してみたのですが、うまくいきませんでした・・・B列にデータが移らないのです(ToT)