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

Question

こんばんは。以前の質問でも、データの抽出に関して教えていただいた者です。皆様の優しさに頼りっきりです。
今回は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>

merlionXX · Accepted Answer

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

n-jun · Answer

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

imogasi · Answer

#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列は空白です。

n-jun · Answer

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

と言う感じでしょうか？

imogasi · Answer

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

merlionXX · Answer

先日回答した
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

KURUMITO · Answer

マクロでなくとも関数で対応できますね。
二つの条件は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セルに検索のキーワードを入力することで対応できますし、データが追加された場合にも即座に対応できるメリットがあります。

imogasi · Answer

VBAの回答が続いているが、質問者はVBAがわかるのかな。多分経験ないだろう。コピーして結果だけ出ればよいのかな。
ーー
自称「imogasi方式」で出来そうです。
データー区切り位置ー（区切り文字）その他「－」ー重複した区切り文字は１文字として扱う、で
A列B列C列
sa1若木に腰掛けな・・
ar1毎日少しずつ。そ・・
sp1「がんばれ、がん・・
sa2骨肉相食む
ar2お前自身を知ろう・・
ac1仕事は来た順。だ・・
のように分けられた。
ただ質問の例の書き方(特にー）が実際かどうかはっきりしないので
不安有るが。
記号列と番号列が分けられないのが実情なら、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列＝ワーク列
sa1若木に腰掛けな1
ar1毎日少しずつ。そ2
sp1「がんばれ、がん
sa2骨肉相食む3
ar2お前自身を知ろう4
ac1仕事は来た順。だ
ーーー
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列
番号
sa1若木に腰掛けな・・
ar1毎日少しずつ。そ・・
sa2骨肉相食む
ar2お前自身を知ろう・・
「（条件付き）抜き出し問題」の色々な解決方法は、Googleで「imogasi方式」で照会すれば、過去質問が相当数出てきて、他の回答者の色々なやり方が有ることが実感できよう。

tom04 · Answer

こんにちは！
的外れの回答かもしれませんが・・・

オートフィルタのオプションを使う方法はどうでしょうか？

↓の画像のようにオートフィルタの設定をした後、
オートフィルタのオプションの抽出条件設定画面で
「sa*」と「等しい」　→　or　「ar*」と「等しい」
又は
「sa」を「含む」　or　「ar」を「含む」としてOK

これで「sa」と「ar」が含まれる行だけ表示されますので
そのB列を範囲指定してSheet2のA列に貼り付けます。

以上、当方使用のExcel2003での回答です。
この程度の回答しか出来ませんが、参考にならなかったら
読み流してくださいね。m(__)m

n-jun · Answer

シート１の１行目には項目行があり、シート２のＡ１以下に貼付けるとしたら、

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

と言う感じでしょうか？

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

No6 merlionXXです。

＃８のn-junです。

#7です。

n-junです。

#4です。

先日回答した

マクロでなくとも関数で対応できますね。

VBAの回答が続いているが、質問者はVBAがわかるのかな。

こんにちは！

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

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング