Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


6627 / 13646 ツリー ←次へ | 前へ→

【43835】複数条件でのデータ検索について yasu145 06/10/26(木) 15:40 質問[未読]
【43849】Re:複数条件でのデータ検索について neptune 06/10/26(木) 21:04 発言[未読]
【43853】Re:複数条件でのデータ検索について ゆと 06/10/26(木) 22:21 発言[未読]
【43856】Re:複数条件でのデータ検索について yasu145 06/10/26(木) 23:51 お礼[未読]
【43850】Re:複数条件でのデータ検索について PiPi 06/10/26(木) 21:52 発言[未読]
【43859】Re:複数条件でのデータ検索について yasu145 06/10/27(金) 0:24 お礼[未読]
【43873】Re:複数条件でのデータ検索について neptune 06/10/27(金) 10:54 発言[未読]
【43879】Re:複数条件でのデータ検索について yasu145 06/10/27(金) 14:58 お礼[未読]
【43883】Re:複数条件でのデータ検索について ponpon 06/10/27(金) 22:38 発言[未読]
【43941】Re:複数条件でのデータ検索について yasu145 06/10/30(月) 12:50 お礼[未読]
【43948】Re:複数条件でのデータ検索について PiPi 06/10/30(月) 19:34 発言[未読]
【44159】Re:複数条件でのデータ検索について yasu145 06/11/6(月) 20:30 お礼[未読]

【43835】複数条件でのデータ検索について
質問  yasu145  - 06/10/26(木) 15:40 -

引用なし
パスワード
   初めて質問させて頂きます。

下記2つの条件(AとB)に該当するデータを
リストから検索して該当したデータをリストアップしたいと思います。

[検索条件]
A= 2.0から 4.0
B=50.0から70.0

[リスト]
A  B   C    D 
1.0 30.0 No.001 倉庫1
1.1 30.0 N0.002 倉庫2
1.2 40.0 No.003 倉庫1
2.0 50.0 No.004 倉庫5
2.1 50.0 No.005 倉庫5
3.0 60.0 No.006 倉庫7
. 
.
.

「Sheet1」に条件を入力 
「Sheet2」にリスト
「Sheet3」に条件に該当したデータのリスト化
を行いたいです。

検索条件が複数ある場合や、条件に範囲がある場合にどのようにすれば良いか
解らず困っております。

どなたかご教授をお願い致します。

【43849】Re:複数条件でのデータ検索について
発言  neptune  - 06/10/26(木) 21:04 -

引用なし
パスワード
   こんばんは
Resが付きませんね。

恐らく原因は「VBA質問箱基本ポリシー」
http://www.vbalab.net/bbspolicy.html
の中の
「何をやったか書いてください」
が全くないからと思います。

さて、本題ですが、通常の操作で、
>リストから検索して該当したデータをリストアップしたいと思います。
はできますか?
出来るならマクロの記録でかなりヒントを得られます。
そして、そこから改良する事も可能です。

出来ないなら、先ず、通常操作の勉強をしましょう。
通常操作が出来てのマクロ(VBA)です。

【43850】Re:複数条件でのデータ検索について
発言  PiPi  - 06/10/26(木) 21:52 -

引用なし
パスワード
   ▼yasu145 さん:
neptuneさんのご指摘の通りと思いますが・・・

今、想像でコードを書いてみました。
こんな感じであれば、後追加訂正をして
本来のしたい内容にされては?

要は、A列の数字の条件(2以上で4以下)
と B列の数字の条件(50以上で70以下)としています。
それに当てはまるもののA列の数字をF列に表示させました。

条件はこれでよかったでしょうか?
後はシート2又は3に4列(A〜D列)をコピー仕上げたら
如何でしょう・・・

Sub NNN()

Dim R As Range
Dim MyR As Range
Set MyR = Range("A1", Range("A65536").End(xlUp))

For Each R In MyR
 If R.Value >= 2 And R.Value <= 4 And R.Offset(, 1).Value >= 50 And R.Offset(, 1).Value <= 70 Then
 R.Copy R.Offset(, 5)
 End If
Next

End Sub

間違っていれば、また書いてください。
識者のneptuneさんをはじめ多くの方の訂正やアドバイスを
いただいてください。

【43853】Re:複数条件でのデータ検索について
発言  ゆと  - 06/10/26(木) 22:21 -

引用なし
パスワード
   こんばんは。

一般操作のオートフィルタ→オプションで事足りるのでは?
と思ってしまいました。
それでは、マズイのでしょうか?^^;

【43856】Re:複数条件でのデータ検索について
お礼  yasu145  - 06/10/26(木) 23:51 -

引用なし
パスワード
   neptune さん、こんばんは。

>恐らく原因は「VBA質問箱基本ポリシー」
>http://www.vbalab.net/bbspolicy.html
>の中の
>「何をやったか書いてください」
>が全くないからと思います。
ご意見ありがとうございます。
質問の仕方も知らずにすみませんでした。

>>リストから検索して該当したデータをリストアップしたいと思います。
>はできますか?
検索はFindを利用して試していましたが、1つの条件であれば出来ましたが
2つの条件を満たす方法が解りませんでした。
Findnextの利用方法もあまり理解出来ていません。

もっと勉強して色々な方法を考えてみます。

【43859】Re:複数条件でのデータ検索について
お礼  yasu145  - 06/10/27(金) 0:24 -

引用なし
パスワード
   PiPi さん、こんばんは。

PiPiさんのコードで問題はクリアになりそうです。
明日ご報告いたします。
ありがとうございます。

【43873】Re:複数条件でのデータ検索について
発言  neptune  - 06/10/27(金) 10:54 -

引用なし
パスワード
   こんにちは
>PiPiさんのコードで問題はクリアになりそうです。
それは良かった。

いらぬお節介かもしれませんが、
データ件数によって、Findとフィルタオプションを使い分けたほうが良いです。
データが増えるに従って、処理は
フィルタオプション>Find
になると思いますので。

Excelで用意されたExcelの標準機能は強力ですから。

【43879】Re:複数条件でのデータ検索について
お礼  yasu145  - 06/10/27(金) 14:58 -

引用なし
パスワード
   neptuneさん、ゆとさん、PiPiさん、こんにちは。
皆さんのご意見を参考にさせて頂き、以下のコードを作ってみました。
なんとか目的の結果に達することが出来ました。
皆さんありがとうございました。

Sub Test1()

  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Set sh1 = Worksheets("List")  'リスト
  Set sh2 = Worksheets("List2")  '条件登録、結果表示

  Dim KeyA1 As String   '条件1(min)
  Dim KeyA2 As String   '条件1(max)
  Dim keyB1 As String   '条件2(min)
  Dim KeyB2 As String   '条件2(max)
  KeyA1 = ">=" & sh2.Cells(2, 2)
  KeyA2 = "<=" & sh2.Cells(2, 3)
  keyB1 = ">=" & sh2.Cells(3, 2)
  KeyB2 = "<=" & sh2.Cells(3, 3)
  
  '先回の結果をクリア (結果表示先List2シートA5:D20)
  sh2.Activate
  Range(Cells(5, 1), Cells(20, 4)).Select
  Selection.ClearContents
  
  'オートフィルターで条件1、条件2を抽出
  sh1.Activate
  sh1.Cells(1, 1).Select
  Selection.AutoFilter
  '条件1
  Selection.AutoFilter Field:=1, Criteria1:=KeyA1, Operator:=xlAnd, _
    Criteria2:=KeyA2
  '条件2
  Selection.AutoFilter Field:=2, Criteria1:=keyB1, Operator:=xlAnd, _
    Criteria2:=KeyB2
  
  '抽出結果をコピーして結果表示場所に貼付け
  Do While ActiveCell.Value <> ""
    ActiveCell.Offset(1).Select
  Loop
  i = ActiveCell.Row
  Range(Cells(1, 1), Cells(i, 4)).Select
  Selection.Copy
  sh2.Activate
  sh2.Cells(5, 1).Select
  ActiveSheet.Paste
  
End Sub

【43883】Re:複数条件でのデータ検索について
発言  ponpon  - 06/10/27(金) 22:38 -

引用なし
パスワード
   フィルターオプションではなく、
オートフィルターでやったのですね?

もう見てないかもしれませんが、私なりに直してみました。
SelectやActivateは出来るだけ使わない方がよろしいかと。

Sub Test1()

  Dim sh1 As Worksheet
  Dim sh2 As Worksheet
  Set sh1 = Worksheets("List")  'リスト
  Set sh2 = Worksheets("List2")  '条件登録、結果表示

  Dim KeyA1 As Single  '条件1(min)
  Dim KeyA2 As Single   '条件1(max)
  Dim keyB1 As Single   '条件2(min)
  Dim KeyB2 As Single   '条件2(max)
  
  KeyA1 = sh2.Cells(2, 2).Value
  KeyA2 = sh2.Cells(2, 3).Value
  keyB1 = sh2.Cells(3, 2).Value
  KeyB2 = sh2.Cells(3, 3).Value
 
  '先回の結果をクリア (結果表示先List2シートA5:D20)
  sh2.Range(sh2.Cells(5, 1), sh2.Cells(20, 4)).ClearContents
  'オートフィルターで条件1、条件2を抽出
  
  With sh1
  '条件1
    .Cells(1, 1).AutoFilter Field:=1, Criteria1:=">=" & KeyA1, Operator:=xlAnd, _
    Criteria2:="<=" & KeyA2
  '条件2
    .Cells(1, 1).AutoFilter Field:=2, Criteria1:=">=" & keyB1, Operator:=xlAnd, _
    Criteria2:="<=" & KeyB2
 
  '抽出結果をコピーして結果表示場所に貼付け
    .AutoFilter.Range.Copy sh2.Cells(5, 1)
    .AutoFilterMode = False
  End With
End Sub

【43941】Re:複数条件でのデータ検索について
お礼  yasu145  - 06/10/30(月) 12:50 -

引用なし
パスワード
   ponpon さん こんにちは。
手直しして頂き、大変勉強になりました。

>SelectやActivateは出来るだけ使わない方がよろしいかと。
直して頂いたコードを参考にして、今後に活かしていきます。

>フィルターオプションではなく、
>オートフィルターでやったのですね?
フィルターオプションの利用方法が判らず今回の方法で作成しました。
まだまだ勉強が足りないので、色々な事例を参考に取組みます。

ありがとうございました。

【43948】Re:複数条件でのデータ検索について
発言  PiPi  - 06/10/30(月) 19:34 -

引用なし
パスワード
   ▼yasu145 さん:
私もこんなので提案、如何でしょう?
Sub test3()
Dim R As Range
Dim MyR As Range
Set MyR = Range("A5", Range("A65536").End(xlUp))
With Worksheets("List2")
For Each R In MyR
 If R.Value >= 2 And R.Value <= 4 And R.Offset(, 1).Value >= 50 And R.Offset(, 1).Value <= 70 Then
 Range(R, R.End(xlToRight)).Copy .Cells(65536, 1).End(xlUp).Offset(1) 
 End If
Next
End With
End Sub

【44159】Re:複数条件でのデータ検索について
お礼  yasu145  - 06/11/6(月) 20:30 -

引用なし
パスワード
   PiPiさん、こんばんは。
お返事遅くなり申し訳ありません。
いろいろな方法が考えられるんですね。
参考にさせて頂きます。
ありがとうございました。

6627 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free