痔になりやすい生活習慣とは?

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

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

A 回答 (10件)

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



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

> UBound(myV, 1) の 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
    • good
    • 0
この回答へのお礼

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

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

お礼日時:2010/12/27 14:29

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



ある文字列AAを入力指定する列A、列Bの2つから探す、
次回は文字列BBかもしれない、では?。

文字列AAを入力指定する列Aから、文字列BBを列Bから探す、
ただし、
文字列AAを列Bからは探さない、
文字列BBを列Aからは探さない、
ですか?。


必ず列2つか1つはないのか。
列2つとも限らないならさらに汎用的になります。
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/27 14:32

同じカテゴリの


4つくらい前の質問で「Excel2007 複数条件での検索」のNO.3にて
サンプル回答しています。

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

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

質問からすると、
「key1条件値に合わない かつ key2条件値に合わない 」は対象外、
以外は(両方一致か片方一致であり)対象、となります。
この考え方でもいいでしょう。IF文1つです。
判定4パターンのうち1つは対象外、3つは対象となる、です。
○○=対象
○×=対象
×○=対象
××=対象外
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/22 16:06

NO5です。


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

>私の希望は、
>  1.Key列に文字あり、Key2列に文字なし
> 2.Key列に文字なし、Key2列に文字あり
>( Key列に文字あり、Key2列に文字あり も含みます)
 ⇒key列が文字列、且つkey2列が文字列以外などの条件で行抽出するという事ならばこの辺りを整理して再質問しては如何でしょうか。
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/21 17:12

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様

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

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

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

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

補足日時:2010/12/22 15:20
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/21 17:15

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
    • good
    • 0
この回答へのお礼

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

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

お礼日時:2010/12/21 15:04

ANo1-3 merlionXXです。



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

コードのどの部分が黄色くなりましたか?
    • good
    • 0
この回答へのお礼

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

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

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

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

お礼日時:2010/12/21 14:37

ANo1 merlionXXです。



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

あなたのコードの
Selection.AutoFilter Field:=Key, Criteria1:="*"
Selection.AutoFilter Field:=Key2, Criteria1:="*"
にあたる部分です。
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/21 11:22

2つの条件で抽出しているのだからどちらかが抽出できない場合、空になります。


よって、抽出前に入力列のデータ個数(例えばCountIf文)を検証し、Key/Key2有、Keyのみ、Key2のみ、Key/Key2なしの条件で選択(例えば、Select Case文)しては如何でしょうか。
    • good
    • 0
この回答へのお礼

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

お礼日時:2010/12/21 11:24

違う列で、2つの抽出条件を満たす行を、それぞれ抽出するならオートフィルターでは無理だと思います。


一例です。
ただ、抽出してそれを新たに作ったシート"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
    • good
    • 0
この回答へのお礼

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

merlionXX様

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

> If myV(i, Key(1)) = "*" Or myV(i, Key(2)) = "*" Then

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

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

お礼日時:2010/12/22 15:50

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!


人気Q&Aランキング