| 
    
     |  | ▼ゆた さん: こんばんは。
 
 >データ.xlsのsheet1に入っている元データからツール.xlsのSheet2上にならべてある条件でオートフィルをかけて、データ.xlsのsheet2に結果を貼り付けるというのを繰り返させたいのですが、どうも動いてくれません。
 >まだVBAを勉強し始めたばかりで、自分の力だけでは解決できそうもありません。どうか宜しくお願いします。
 この投稿には、いくつかの問題があります。
 
 1. コードだけの提示では、「どうも動いてくれません。」の事情がわからないということです。
 
 だって、フィルタ処理を行うためには、データが必要です。
 
 どのようなデータをフィルタ処理するのか記述されていません。
 
 提示されたコードだとAdvancedFilterメソッドを使っていますね?
 そうすると抽出条件もコードからはわかりません。
 
 さらに最終的にどうのような結果をブック「データ.xls」の2番目のシートに表示したいのかが 明確になっていません!!。
 
 つまり、情報処理に必要不可欠な
 処理機能の説明
 入力データの説明(具体例を示す)
 出力データの説明(入力データの具体例から出力データの例を説明)
 
 が不完全ということです。
 
 具体的な入力データや出力データを記述してもらえないと
 回答者は、入力データを作成しなければなりません。
 (質問者が記述してくれさえすれば、コピーで済むのに・・・)。
 
 例えば、
 
 新規ブックBook1.xlsのSheet1というシートに
 
 A    B     C    D     E    F
 1  項目1   項目2   項目3   項目4   項目5   項目6
 2   1     2     3     4     5     6
 3   2     3     4     5     6     7
 4   3     4     5     6     7     8
 5   4     5     6     7     8     9
 6   5     6     7     8     9     10
 7   6     7     8     9     10     11
 
 
 というデータが入力されているとします。
 
 Book1.xlsのSheet2(左から、2番目のシートは未入力シートのままです)
 
 新規ブックBook2.xlsのSheet2というシートには、抽出条件である以下のデータを入力します。
 
 A    B
 5   項目1   項目2
 6    1     2
 7
 8
 9
 10   項目1   項目2
 11    2     3
 12
 13
 14
 15   項目1   項目2
 16    3     4
 
 
 これが抽出条件です。
 
 このデータでフィルタ処理した場合、
 Book1.xlsのSheet2(左から2番目のシート)には
 
 A    B     C    D     E    F
 1  項目1   項目2   項目3   項目4   項目5   項目6
 2   1     2     3     4     5     6
 3
 4  項目1   項目2   項目3   項目4   項目5   項目6
 5   2     3     4     5     6     7
 6
 7  項目1   項目2   項目3   項目4   項目5   項目6
 8   3     4     5     6     7     8
 
 という結果を表示します。
 
 コードを拝見した限りでは、上記の結果を表示したいのかなあ
 
 と想像しました
 (項目名が抽出毎の表示が必要かは疑問でしたが、コードを拝見した限りで
 判断しました)。
 
 
 だとすると、
 
 Book1.xls Book2.Xls どちらの標準モジュールでもかまいませんが、
 
 統一してBook1.xlsの 標準モジュールに
 
 '================================
 Sub main()
 Dim a As Long
 Dim b As Long
 Dim d As Long
 Dim x As Long
 Dim rng As Range
 Dim crng As Range
 Dim prng As Range
 With Workbooks("book1.xls").Worksheets(1)
 Set rng = .Range("a1", .Cells(.Rows.Count, 1).End(xlUp)).Resize(, 6)
 .Next.Cells.ClearContents
 End With
 d = 1
 For x = 0 To 2
 a = x * 5 + 5
 b = x * 5 + 6
 With Workbooks("book2.xls").Sheets("Sheet2")
 Set crng = .Range(.Cells(a, 2), .Cells(b, 3))
 End With
 Set prng = Workbooks("book1.xls").Worksheets(2).Cells(d, 1)
 Call フィルタ処理(rng, crng, prng)
 With Workbooks("book1.xls").Worksheets(2)
 d = .Cells(.Rows.Count, 1).End(xlUp).Row + 2
 End With
 Next
 End Sub
 '==================================================================
 Sub フィルタ処理(rng As Range, ctrrng As Range, cpyrng As Range)
 '機能  :指定されたセル範囲を指定された条件でフィルタ処理し、結果を指定位置にコピーする
 'input  :rng フィルタをかけるセル範囲
 '     crng フィルタ条件が入力されているセル範囲
 '     prng フィルタ結果を表示する開始セル
 rng.Parent.Activate
 rng.AdvancedFilter Action:=xlFilterCopy, _
 CriteriaRange:=ctrrng, _
 copytorange:=cpyrng
 
 End Sub
 
 として、mainを実行してみてください。
 (Book1.Xls及び、Book2.Xlsは 一度、それぞれの名前で保存してから実行すること)
 
 
 呼び出しプロシジャーはオートフィルではないので名前は変えました。
 
 2. プロシジャー呼び出しを行うときのデータの受け渡しは、
 出来うる限りパラメータ渡しを使うことです。
 
 これにより、個々のプロシジャーの結合度が弱くなり、汎用性(再利用可能)が
 高まります。
 
 これについては、以前にも投稿して事があります。
 www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=28808;id=excel
 
 3.直接のエラーの原因は、
 Range(Cells(1, 1), Cells(r, 13)).AdvancedFilter _
 Action:=xlFilterInPlace, _
 CriteriaRange:=Workbooks("ツール.xls").Sheets("Sheet2").Range(Cells(a, 2), Cells(b, 3))
 
 これでしょうか?
 
 Workbooks("ツール.xls").Sheets("Sheet2").Range(Workbooks("ツール.xls").Sheets("Sheet2").Cells(a, 2), Workbooks("ツール.xls").Sheets("Sheet2").Cells(b, 3))
 
 本来なら、↑このように記述しなければなりません。
 
 
 まずは、上記のように今問題を抱えているブックではなく、
 新規ブックで上記の手順でデータやコードを作成して試して見てください。
 
 
 |  |