| |
▼Kein さん：
>>次の処理
>とは何なのか、説明しないと分かりません。３つのシートで連続してフィルター
>をかける、とだけ書かれていたら誰でも「次のシートに移ること」と解釈しますよ。
説明不足で申し訳ありません。
次の処理とは、確かに次のシートに移ることなのですが、各シートでオートフィルタをかけて、コピーペーストをし、データがなければ、次のシートに移りオートフィルタをかけてコピーペーストをする。を繰り返しています。
但し、フィルタ条件が各シート異なり、コピーペースト範囲も違うので、LOOPは使わずに1シートずつさせています。
少々長くなりますが、以下に処理コードを記述しますね。
Sub テスト()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim wb1 As Worksheet
Dim wb2 As Worksheet
Dim WB As Workbook
Set WS1 = Sheet(1)
Set WS2 = Sheet(2)
Set WS3 = Sheet(3)
Set WB = Workbooks.Open(Filename:="C:\****\****\sanmple.xls")
Set wb1 = WB.Sheets("サンプル")
'シート1の最終行を取得
ar = WS1.Range("A65536").End(xlUp).Row
'シート1を5列目に抽出条件を1月1日〜12月31日目までと設定してオートフィルタを設定する。
With WS1
.AutoFilterMode = 0
.Range("A2:A" & ar).CurrentRegion.AutoFilter 5, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2007/12/31"
End With
'もし、2列目以降が空白なら、処理に進む
If WorksheetFunction.CountA(Range("A2:A65536") _
.SpecialCells(xlCellTypeVisible)) = 0 Then
GoTo 処理
End If
'可視セルの最終行までを選択
With WS1.Range("A2", WS1.Range("A65536").End(xlUp)) _
.SpecialCells(xlCellTypeVisible)
WS1.AutoFilter.Range.SpecialCells (xlCellTypeVisible)
.Offset(,1).Copy
wb1.Range("A2").Offset(, -3).PasteSpecial Paste:=xlValues
・
・
・
End With
処理:'シート2の最終行を取得
BR = WS3.Range("A65536").End(xlUp).Row
'シート1を6列目に抽出条件を1月1日〜12月31日目までと設定してオートフィルタを設定する。
With WS2
.AutoFilterMode = 0
.Range("A2:A" & BR).CurrentRegion.AutoFilter 6, Criteria1:=">=2006/1/1", Operator:=xlAnd, Criteria2:="<=2006/12/31"
End With
'もし、2列目以降が空白なら、処理2に進む
If WorksheetFunction.CountA(Range("A2:A65536") _
.SpecialCells(xlCellTypeVisible)) = 0 Then
GoTo 処理2
End If
'サンプルシートのB列の空白を含む最終行を取得
Set rngTemp = wb1.Cells(Rows.Count, 2).End(xlUp).Offset(1)
'シート3の可視セルの最終行までを
With WS3.Range("A2", WS3.Range("A65536").End(xlUp)) _
.SpecialCells(xlCellTypeVisible)
'シート3の可視セルを列ごとサンプルシートへ転記
WS3.AutoFilter.Range.SpecialCells (xlCellTypeVisible)
.Offset(, 3).Copy
rngTemp.Offset(, -3).PasteSpecial Paste:=xlValues
・
・
・
End With
処理2:'サンプルシートのA８を基準にソートする。
Const myOrder As Integer = xlAscending
wb1.Range("A8:U1252").Sort _
Key1:=Range("A8"), _
Order1:=myOrder, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlSortRows
End Sub
という感じです。
処理の内容（フィルタの条件や抽出元）がシート毎に違うので、Forは使えないかなと思ったのですが・・・。
使えますか？
|
|
momo
- 06/5/2(火) 9:29 -
