Excel VBA質問箱 IV

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

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


9773 / 13644 ツリー ←次へ | 前へ→

【25543】4つの条件を満たす行を検索する方法 ikeda 05/6/3(金) 21:51 質問[未読]
【25546】Re:4つの条件を満たす行を検索する方法 Kein 05/6/3(金) 22:19 回答[未読]
【25547】Re:4つの条件を満たす行を検索する方法 Kein 05/6/3(金) 22:22 回答[未読]
【25548】Re:4つの条件を満たす行を検索する方法 ikeda 05/6/3(金) 23:16 お礼[未読]

【25543】4つの条件を満たす行を検索する方法
質問  ikeda  - 05/6/3(金) 21:51 -

引用なし
パスワード
   どなたか教えてください。
1.データシートから条件にあった行をワークシートにコピーしたい
2.上記以外のデータを除外シートにコピーしたい
のです。

1のデータ抽出でつまずいています
書いたコードは以下のものです。オートフィルターでは4つの条件は
無理なのでしょうか?


  'データ数を求める
  Sheets("データ").Activate
  gyo = Sheets("データ").Range("a1").CurrentRegion.Rows.Count - 1
  
  'データシートから必要なデータを抽出
  Worksheets("データ").Range("A5").CurrentRegion.Select

(この下の行でエラーです)

  Selection.AutoFilter Field:=4, Criteria2:="=250", Operator:=xlOr, Criteria2:="=280", _
     Operator:=xlOr, Criteria2:="=350", Operator:=xlOr, Criteria2:="=500"
  Selection.Copy
  
 
  'ワークシートにとりあえずコピー
  Set ws = Worksheets.Add
  ws.Paste
  ws.Name = "ワーク"
  '見出し行コピー
  Sheets("orion").Activate
  Worksheets("orion").Rows("5:5").Select
  Selection.Copy
  Sheets("ワーク").Activate
  ws.Range("A1").Select
  ws.Paste

  Application.CutCopyMode = False
  Set ws = Nothing
  
  Sheets("orion").AutoFilterMode = False

【25546】Re:4つの条件を満たす行を検索する方法
回答  Kein  - 05/6/3(金) 22:19 -

引用なし
パスワード
   そーいうときは、数式を埋めて判定すればよいでしょう。例えばAD列を作業列として

On Error Resume Next
Set WS = Sheets("ワーク")
If Err.Number <> 0 Then
  Set WS = Worksheets.Add
  WS.Name = "ワーク"
  Err.Clear
End If
With Sheets("データ")
  With .Range("D2", .Range("D65536").End(xlUp)).Offset(, 26)
   .Formula = "=IF(OR(D2=250,D2=280,D2=350,D2=500),1,"""")"
   .SpeciaCells(3, 1).EntireRow.Copy
   Sheets("ワーク").Range("A1").PasteSpecial xlPasteValues
   .ClearContents
  End With
End With
Sheets("ワーク").Range("AD:AD").ClearContents

【25547】Re:4つの条件を満たす行を検索する方法
回答  Kein  - 05/6/3(金) 22:22 -

引用なし
パスワード
   Sub Test()
  Dim WS As Worksheet

  On Error Resume Next
  Set WS = Sheets("ワーク")
  If Err.Number <> 0 Then
   Set WS = Worksheets.Add
   WS.Name = "ワーク"
   Err.Clear
  End If
  With Sheets("データ")
   With .Range("D2", .Range("D65536").End(xlUp)).Offset(, 26)
     .Formula = "=IF(OR(D2=250,D2=280,D2=350,D2=500),1,"""")"
     .SpeciaCells(3, 1).EntireRow.Copy
     WS.Range("A1").PasteSpecial xlPasteValues
     .ClearContents
   End With
  End With
  WS.Range("AD:AD").ClearContents
  Set WS = Nothing
End Sub

てな感じです。

【25548】Re:4つの条件を満たす行を検索する方法
お礼  ikeda  - 05/6/3(金) 23:16 -

引用なし
パスワード
   ▼Kein さん:

ありがとうございました。
無事解決できました!

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