| |
▼ゆた さん：
こんばんは。
>データ.xlsのsheet1に入っている元データからツール.xlsのSheet2上にならべてある条件でオートフィルをかけて、データ.xlsのsheet2に結果を貼り付けるというのを繰り返させたいのですが、どうも動いてくれません。
>まだVBAを勉強し始めたばかりで、自分の力だけでは解決できそうもありません。どうか宜しくお願いします。
この投稿には、いくつかの問題があります。
1. コードだけの提示では、「どうも動いてくれません。」の事情がわからないということです。
だって、フィルタ処理を行うためには、データが必要です。
どのようなデータをフィルタ処理するのか記述されていません。
提示されたコードだとAdvancedFilterメソッドを使っていますね？
そうすると抽出条件もコードからはわかりません。
さらに最終的にどうのような結果をブック「データ.xls」の２番目のシートに表示したいのかが 明確になっていません！！。
つまり、情報処理に必要不可欠な
処理機能の説明
入力データの説明（具体例を示す）
出力データの説明（入力データの具体例から出力データの例を説明）
が不完全ということです。
具体的な入力データや出力データを記述してもらえないと
回答者は、入力データを作成しなければなりません。
（質問者が記述してくれさえすれば、コピーで済むのに・・・）。
例えば、
新規ブックBook1.xlsのSheet1というシートに
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１ 項目1 項目2 項目3 項目4 項目5 項目6
２ 1 2 3 4 5 6
３ 2 3 4 5 6 7
４ 3 4 5 6 7 8
５ 4 5 6 7 8 9
６ 5 6 7 8 9 10
７ 6 7 8 9 10 11
というデータが入力されているとします。
Book1.xlsのSheet2（左から、2番目のシートは未入力シートのままです）
新規ブックBook2.xlsのSheet2というシートには、抽出条件である以下のデータを入力します。
Ａ Ｂ
５ 項目1 項目2
６ 1 2
７
８
９
１０ 項目1 項目2
１１ 2 3
１２
１３
１４
１５ 項目1 項目2
１６ 3 4
これが抽出条件です。
このデータでフィルタ処理した場合、
Book1.xlsのSheet2（左から2番目のシート）には
Ａ Ｂ Ｃ Ｄ Ｅ Ｆ
１ 項目1 項目2 項目3 項目4 項目5 項目6
２ 1 2 3 4 5 6
３
４ 項目1 項目2 項目3 項目4 項目5 項目6
５ 2 3 4 5 6 7
６
７ 項目1 項目2 項目3 項目4 項目5 項目6
８ 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は 一度、それぞれの名前で保存してから実行すること）
呼び出しプロシジャーはオートフィルではないので名前は変えました。
２. プロシジャー呼び出しを行うときのデータの受け渡しは、
出来うる限りパラメータ渡しを使うことです。
これにより、個々のプロシジャーの結合度が弱くなり、汎用性（再利用可能）が
高まります。
これについては、以前にも投稿して事があります。
www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=28808;id=excel
３．直接のエラーの原因は、
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))
本来なら、↑このように記述しなければなりません。
まずは、上記のように今問題を抱えているブックではなく、
新規ブックで上記の手順でデータやコードを作成して試して見てください。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
