Excel VBA質問箱 IV

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

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


44375 / 76732 ←次へ | 前へ→

【37376】Re:オートフィルタの結果がもし空白なら
質問  momo  - 06/5/2(火) 9:29 -

引用なし
パスワード
   ▼Kein さん:
>>次の処理
>とは何なのか、説明しないと分かりません。3つのシートで連続してフィルター
>をかける、とだけ書かれていたら誰でも「次のシートに移ること」と解釈しますよ。

説明不足で申し訳ありません。
次の処理とは、確かに次のシートに移ることなのですが、各シートでオートフィルタをかけて、コピーペーストをし、データがなければ、次のシートに移りオートフィルタをかけてコピーペーストをする。を繰り返しています。
但し、フィルタ条件が各シート異なり、コピーペースト範囲も違うので、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:'サンプルシートのA8を基準にソートする。 
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は使えないかなと思ったのですが・・・。
使えますか?
0 hits

【37345】オートフィルタの結果がもし空白なら momo 06/5/1(月) 13:33 質問
【37348】Re:オートフィルタの結果がもし空白なら ハチ 06/5/1(月) 13:47 回答
【37350】Re:オートフィルタの結果がもし空白なら momo 06/5/1(月) 14:44 質問
【37352】Re:オートフィルタの結果がもし空白なら ハチ 06/5/1(月) 15:33 発言
【37355】Re:オートフィルタの結果がもし空白なら Jaka 06/5/1(月) 16:16 発言
【37364】Re:オートフィルタの結果がもし空白なら momo 06/5/1(月) 17:57 質問
【37366】Re:オートフィルタの結果がもし空白なら Kein 06/5/1(月) 18:21 発言
【37376】Re:オートフィルタの結果がもし空白なら momo 06/5/2(火) 9:29 質問
【37377】Re:オートフィルタの結果がもし空白なら Jaka 06/5/2(火) 11:16 発言
【37379】追加 Jaka 06/5/2(火) 13:21 発言
【37380】Re:追加 momo 06/5/2(火) 14:27 お礼
【37381】Re:追加 Jaka 06/5/2(火) 15:30 発言
【37351】Re:オートフィルタの結果がもし空白なら Kein 06/5/1(月) 15:13 回答

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