違う列で、２つの抽出条件を満たすには

質問

OSはXPで、Excel2003を使用しています。
下記のマクロですと、Key列に任意の文字があって、Key2列に任意の文字が入っていなくても抽出されますが、
その逆、Key列に任意の文字がなくて、Key2列に任意の文字が入っている場合は抽出されません。
前者の場合も、後者の場合も抽出される様にするには、どの様にすれば良いか教えて下さい。
*****
Sub test()
Dim Key As String
Dim Key2 As String
Key = Application.InputBox("抽出列の番号を入れて下さい")
Key2 = Application.InputBox("抽出列の番号を入れて下さい")
Worksheets.add After:=ActiveSheet, Count:=1
ActiveSheet.Name = "BBBB"
Sheets("AAAA").Activate
Range("A1").Select
Selection.AutoFilter
Selection.AutoFilter Field:=Key, Criteria1:="*"
Selection.AutoFilter Field:=Key2, Criteria1:="*"
Selection.CurrentRegion.Copy

Sheets("BBBB").Activate
Range("A1").PasteSpecial Paste:=xlAll
Selection.CurrentRegion.Select

End Sub

*******
説明不足な所がございましたら追記致します。
何卒よろしくお願い致します。

回答No.9

merlionXX · ベストアンサー

>　シート名は先に付けるのではなく、後で付ける方がいいんですね。

そんなことは無いです。
こちらでテストするとき、Sheet("BBBB")が存在するとエラーになるので、シートをいちいち削除するのが面倒だったのではずして、最後に付け加えただけです。

>　UBound(myV, 1)　の　1　なんですが、１次元って意味なんですよね？

その通りです。

> ただ、検索値は"送"だけでなく、"来"や"送・来"も含めたいし、他の列だと、"新"や"再"とかもあるので

列ごとに検索値が異なるということですか？
ならば、その都度指定しなければなりませんね。
それとも、この列ならこの文字という対照表のようなものがありますか？
あれば、そこから読み込んでもいいですが、とりあえず列番号の入力の際に聞くこととにしてみます。

Sub test04()
　　Dim myV, myW
　　Dim ws As Worksheet
　　Dim Key(1 To 2) As Long, x As Long, y As Long, i As Long, n As Long, j As Long, r As Long
　　Dim myStr(1 To 2) As String
　　myV = Sheets("AAAA").Range("A1").CurrentRegion.Value

　　x = UBound(myV, 1)
　　y = UBound(myV, 2)
　　ReDim myW(1 To x, 1 To y)
　　For r = 1 To 2
　　　　Key(r) = Application.InputBox("抽出列の番号を数値で入れて下さい。", "列番号入力")
　　　　If Key(r) > y Then
　　　　　　MsgBox "範囲外の列番号です。", vbCritical, "Σ（￣ロ￣lll) "
　　　　　　Exit Sub
　　　　End If
　　　　myStr(r) = Application.InputBox(Key(r) & "列の検索値を入れて下さい。", "検索文字入力")
　　Next r
　　For i = 1 To x
　　　　If myV(i, Key(1)) = myStr(1) Or myV(i, Key(2)) = myStr(2) Then
　　　　　　j = j + 1
　　　　　　For n = 1 To y
　　　　　　　　myW(j, n) = myV(i, n)
　　　　　　Next n
　　　　End If
　　Next i
　　If j = 0 Then
　　　　MsgBox Key(1) & "列と" & Key(2) & "列に検索値がみあたりません。", vbCritical, "Σ（￣ロ￣lll) "
　　　　Exit Sub
　　End If
　　Set ws = Sheets.Add(After:=ActiveSheet)
　　With ws
　　　　.Range("A2").Resize(j, y).Value = myW '
　　　　Sheets("AAAA").Rows(1).Copy .Rows(1)
　　.Activate
　　End With
　　ws.Name = "BBBB"
End Sub

お礼

お礼が遅くなってすみません!!

test04で、指定した文字で抽出出来ました！
最後まで丁寧にご教授頂き、
今回教えて頂いて事は他のマクロにも使えそうですし、
本当にありがとうございました。

回答No.10

layy

実行のたびに検索２列や検索文字列は変わるとして

ある文字列ＡＡを入力指定する列Ａ、列Ｂの２つから探す、
次回は文字列ＢＢかもしれない、では？。

文字列ＡＡを入力指定する列Ａから、文字列ＢＢを列Ｂから探す、
ただし、
文字列ＡＡを列Ｂからは探さない、
文字列ＢＢを列Ａからは探さない、
ですか？。

必ず列２つか１つはないのか。
列２つとも限らないならさらに汎用的になります。

お礼

返信が遅くなってしまってすみません!!
色々なアプローチの仕方があるんですね。
勉強になりました。
何度も返信下さり、ありがとうございました。

回答No.8

layy

同じカテゴリの
４つくらい前の質問で「Excel2007 複数条件での検索」のＮＯ．３にて
サンプル回答しています。

シート１から２つの条件に見合う行をシート２へ転記していますから、
用途があえば参考にしてみてください。

ｋｅｙ１に一致、ｋｅｙ２に一致、のケースは流用し、
これにｋｅｙ１にしか合わないもの、ｋｅｙ２にしか合わないもの、を
アレンジしてみてはどうでしょうか。

質問からすると、
「key1条件値に合わない　かつ　key2条件値に合わない　」は対象外、
以外は（両方一致か片方一致であり）対象、となります。
この考え方でもいいでしょう。ＩＦ文１つです。
判定４パターンのうち１つは対象外、３つは対象となる、です。
○○＝対象
○×＝対象
×○＝対象
××＝対象外

お礼

回答ありがとうございます。
コード内容をよく見て、別のアプローチの仕方もある事を勉強させて頂きます。

回答No.7

mu2011

NO5です。
>Key列 と Key2列 の『両方に　任意の文字（"*"）は入っているモノだけ』が抽出されます。
　⇒ご例示のマクロコードにミスリードさせられましたので前回答は読み捨て下さい。

>私の希望は、
>　 １．Key列に文字あり、Key2列に文字なし
>　２．Key列に文字なし、Key2列に文字あり
>（ Key列に文字あり、Key2列に文字あり も含みます）
　⇒key列が文字列、且つkey2列が文字列以外などの条件で行抽出するという事ならばこの辺りを整理して再質問しては如何でしょうか。

お礼

早々の返信ありがとうございます。
皆様のご回答を整理して、よく勉強させて頂きます。

回答No.6

merlionXX

merlionXXです。
そこがエラーになったのなら、検索値がご指定の列に存在しなかった可能性が高いです。

これでためしてください。

Sub test03()
　　Dim myV, myW
　　Dim ws As Worksheet
　　Dim Key(1 To 2) As Long, x As Long, y As Long, i As Long, n As Long, j As Long, r As Long
　　myV = Sheets("AAAA").Range("A1").CurrentRegion.Value

　　x = UBound(myV, 1)
　　y = UBound(myV, 2)
　　ReDim myW(1 To x, 1 To y)
　　For r = 1 To 2
　　　　Key(r) = Application.InputBox("抽出列の番号を数値で入れて下さい。")
　　　　If Key(r) > y Then
　　　　　　MsgBox "範囲外の列番号です。", vbCritical, "Σ（￣ロ￣lll) "
　　　　　　Exit Sub
　　　　End If
　　Next r
　　For i = 1 To x
　　　　If myV(i, Key(1)) = "*" Or myV(i, Key(2)) = "*" Then
　　　　　　j = j + 1
　　　　　　For n = 1 To y
　　　　　　　　myW(j, n) = myV(i, n)
　　　　　　Next n
　　　　End If
　　Next i
　　If j = 0 Then
　　　　MsgBox Key(1) & "列と" & Key(2) & "列に検索値がみあたりません。", vbCritical, "Σ（￣ロ￣lll) "
　　　　Exit Sub
　　End If
　　Set ws = Sheets.Add(After:=ActiveSheet)
　　With ws
　　　　.Range("A2").Resize(j, y).Value = myW '
　　　　Sheets("AAAA").Rows(1).Copy .Rows(1)
　　.Activate
　　End With
　　ws.Name = "BBBB"
End Sub

お礼

返信ありがとうございます。
今日はあまり時間が取れず、検証出来そうになく、
merlionXXさんの方が先に先に考えて下さっていて申し訳ないです。
明日は時間が取れるかと思いますので、少し時間下さい。

補足

merlionXX様

上記のコードのままですと、『列に検索値がみあたりません』のMsgBoxが出るので、
検索値をそのものの文字（"送"という文字）を当てはめて見たところ、
私が希望していた通りの抽出結果で別シート(BBBB)にコピペ出来ました！
（シート名は先に付けるのではなく、後で付ける方がいいんですね。）

ただ、検索値は"送"だけでなく、"来"や"送・来"も含めたいし、
他の列だと、"新"や"再"とかもあるので、任意の文字(="*"だと思っていたのがそもそもの間違いだったのでしょうか？）にしたかったのですが、
その場合ですと、どうしたらいいのか　教えて頂けないでしょうか？

あと、UBound(myV, 1)　の　1　なんですが、１次元って意味なんですよね？
行の下限数を調べられるって事と思っていいのでしょうか？
同じく、２　だと２次元で、列の下限数　ですよね？
イミディットで確認したら、表の行数と列数だったので。

質問ばかりで申し訳ありません。
よろしければ、ご回答頂けますと助かります。
よろしくお願い致します。

回答No.5

mu2011

NO2です。
入力の妥当性等は無視して前回のコードを展開してみましたが如何でしょうか。

Sub test()
Dim Key As String
Dim Key2 As String
Key = Application.InputBox("抽出列の番号を入れて下さい")
Key2 = Application.InputBox("抽出列の番号を入れて下さい")
flgA = WorksheetFunction.CountIf(Cells(1, Val(Key)).EntireColumn, "*") > 1
flgB = WorksheetFunction.CountIf(Cells(1, Val(Key2)).EntireColumn, "*") > 1
If Not (flgA Or flgB) Then Exit Sub
Worksheets.Add After:=ActiveSheet, Count:=1
ActiveSheet.Name = "BBBB"
Sheets("AAAA").Activate
Range("A1").Select
Selection.AutoFilter
Select Case True
Case flgA And flgB
Selection.AutoFilter Field:=Key, Criteria1:="*"
Selection.AutoFilter Field:=Key2, Criteria1:="*"
Case flgA
Selection.AutoFilter Field:=Key, Criteria1:="*"
Case flgB
Selection.AutoFilter Field:=Key2, Criteria1:="*"
End Select
Selection.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Sheets("BBBB").Range("A1")
Sheets("AAAA").AutoFilterMode = False
End Sub

お礼

mu2011さんも返信下さってありがとうございます。

書いて下さったコードですと、
Key列 と Key2列 の『両方に　任意の文字（"*"）は入っているモノだけ』が抽出されます。
私の希望は、
　 １．Key列に文字あり、Key2列に文字なし
　２．Key列に文字なし、Key2列に文字あり
（ Key列に文字あり、Key2列に文字あり も含みます）
この２つに該当する行を抽出して、BBBBシートにコピペしたいという事なんです。
説明が下手で申し訳ないです。

回答No.4

merlionXX

ANo1-3 merlionXXです。

> そのままではデバックになりますので

コードのどの部分が黄色くなりましたか？

お礼

返信下さってありがとうございます。

>コードのどの部分が黄色くなりましたか？

.Range("A2").Resize(j, y).Value = myW
の部分です。

通常仕事の合間にやっているので、まだ頂いたコードを勉強出来ていません。
本当は気付くべき事を気付けていない可能性があります。
申し訳ありません。

回答No.3

merlionXX

ANo1 merlionXXです。

昨日回答したコードですが、
If myV(i, Key(1)) = "1" Or myV(i, Key(2)) = "4" Then
この部分、自分で検索値を、１と４で試したのをそのままにしてしまいました。
ここは、実際の検査値を入れてください。

あなたのコードの
Selection.AutoFilter Field:=Key, Criteria1:="*"
Selection.AutoFilter Field:=Key2, Criteria1:="*"
にあたる部分です。

お礼

ご回答頂きありがとうございます。
ANo1で書いて下さいましたコードを（検索値などは変更しましたが）
そのままではデバックになりますので
もう一度一行一行よく理解してから自分の表に当てはめてみたいと思います。
使った事のないコード（UBound）があり新しい事を勉強出来る様に思います。
申し訳ありませんが、『ベストアンサー回答』までにはすこし時間を下さい。

回答No.2

mu2011

２つの条件で抽出しているのだからどちらかが抽出できない場合、空になります。
よって、抽出前に入力列のデータ個数（例えばCountIf文）を検証し、Key/Key2有、Keyのみ、Key2のみ、Key/Key2なしの条件で選択（例えば、Select Case文）しては如何でしょうか。

お礼

CountIf文、Select Case文ですね。
調べて、当てはめてみたいと思います。
ご回答頂きありがとうございます。

回答No.1

merlionXX

違う列で、２つの抽出条件を満たす行を、それぞれ抽出するならオートフィルターでは無理だと思います。
一例です。
ただ、抽出してそれを新たに作ったシート"BBBB"に転記と決め打ちすると、同じシート名は二つ作れないので一回しか抽出できませんがほんとにこれでいいんでしょうか？

Sub test02()
　　Dim myV, myW
　　Dim Key(1 To 2) As Long, x As Long, y As Long, i As Long, n As Long, j As Long, r As Long
　　myV = Sheets("AAAA").Range("A1").CurrentRegion.Value
　　x = UBound(myV, 1)
　　y = UBound(myV, 2)
　　ReDim myW(1 To x, 1 To y)
　　For r = 1 To 2
　　　　Key(r) = Application.InputBox("抽出列の番号を入れて下さい")
　　　　If Key(r) > y Then
　　　　　　MsgBox "範囲外の列番号です。", vbCritical, "Σ（￣ロ￣lll) "
　　　　　　Exit Sub
　　　　End If
　　Next r
　　For i = 1 To x
　　　　If myV(i, Key(1)) = "1" Or myV(i, Key(2)) = "4" Then
　　　　　　j = j + 1
　　　　　　For n = 1 To y
　　　　　　　　myW(j, n) = myV(i, n)
　　　　　　Next n
　　　　End If
　　Next i
　　Sheets.Add After:=ActiveSheet
　　ActiveSheet.Name = "BBBB"
　　With Sheets("BBBB")
　　　　.Range("A2").Resize(j, y).Value = myW
　　　　Sheets("AAAA").Rows(1).Copy .Rows(1)
　　.Activate
　　End With
End Sub

お礼

（書くところがないので、ここに書かせていただきます。）

merlionXX様

No.6の補足のところで質問させていただいた１つ、自己解決出来ました。

>　If myV(i, Key(1)) = "*" Or myV(i, Key(2)) = "*" Then
を
If myV(i, Key(1)) ><"" Or myV(i, Key(2))><""Then
に変更したら、私の希望通りになりました。

No.6をベストアンサーにさせていただきたいと思います。
本当にありがとうございました。