Excel VBA質問箱 IV

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

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


37999 / 76732 ←次へ | 前へ→

【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
1 hits

【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 お礼

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