[[20111014140154]] 『フィルターで検索した物を別シートにコピー後削除』(りんご) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『フィルターで検索した物を別シートにコピー後削除』(りんご)

 毎回、毎回お世話になっております。
 この度も宜しくお願い致します。

 シート名「総体」に下記データがあります。
      A    B    C    D
 1  コード   氏名      住所   完了日
 2   111    橘   東京都      
 3   112   吉本   千葉県    8/4
 4   113    泉   埼玉県     
 5   114    西   北海道   8/10

 このデータの「完了日」に値入力があるものだけをフィルタで表示させ
 「完了」シートにコピーをします。
 その後コピーが完了した「総体」シートのデータを削除します。

 「完了」シートには「総体」シートで完了になったデータを
 順次コピーしていき、データを蓄積させていきたいと考えています。
 「総体」シートには進行中のデータのみ。
 「完了」シートは完了したデータのみ存在するようにしたいのです。

 その都度の作業は手間がかかるのでマクロを組みたいと思っているのですが
 いまいち頭が働きません。皆様のお知恵をお貸しください。
 宜しくお願い致します。

 WindowsXP,Excel2007


 構成としては以下になるかな。
で、ほとんどマクロ記録ができるので、まずチャレンジしてみたらどうかな?
1.総体シートにオートフィルターを設定
2.完了日が空白でないもので抽出
3.これでいいかメッセージをだし
4.No ならオートフィルターを解除して終了
5.OK なら、総体シートのセルをすべて選び
6.Ctrl/cでコピーし
7.完了シートを選択し
8.完了シートのセルをすべて選択し
9.Ctrl/v でペースト。
10.総体シートに戻って、
11.完了日空白で抽出し
12.抽出された行を上から下まで選んで削除
13.オートフィルターを解除

 ここで、12.だけはコード内に固定値が生成されるので、別途手当が必要だけど、まず、ここまでがんばれるかな?

 追記)あぁ、毎月、完了シートに「追加」なんだね。
   じゃぁ、5.はすべてのセルを選ぶのではなく、抽出された行を選ぶ。
   で、8.も完了シートの追加すべき行のA列を選ぶ。

 (ぶらっと)


 追加というか、おまけ。
マクロ記録をもとにがんばっていくこと プラス 参考部品としていくつか。
(これ以外にも様々な方法があるけど一例として)

 Sub Sample1()
    'そのシートにオートフィルター設定がなされているかどうか
    MsgBox Sheets("Sheet1").AutoFilterMode
    'そのシートでオートフィルターあるいはフィルターオプションでデータの絞り込みがされている状態かどうか
    MsgBox Sheets("Sheet1").FilterMode
 End Sub

 Sub Sample2()
    'オートフィルターが設定されているならそれを解除(結果、全データが表示される)
    'オートフィルターが設定されていないならリスト内の任意の単一セルあるいはリストのすべての領域を指定して設定をする。
    Sheets("Sheet1").Range("A1").AutoFilter
 End Sub

 Sub Sample3()
    'オートフィルターあるいはフィルターオプションで抽出された(非表示行がある)状態で全行を表示させる。
    '非表示行がない状態ではエラーになるので注意
    Sheets("Sheet1").ShowAllData
 End Sub

 Sub Sample4()
    'オートフィルターで抽出された行数
    MsgBox Sheets("Sheet1").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).Cells.Count - 1
 End Sub

 Sub Sample5()
    'オートフィルターで抽出されたデータをタイトル行も含めて別シートにコピー
    Sheets("Sheet1").AutoFilter.Range.Copy Sheets("Sheet2").Range("A1")
 End Sub

 Sub Sample6()
    'オートフィルターで抽出されたデータをデータ行のみ別シートにコピー
    Intersect(Sheets("Sheet1").AutoFilter.Range, Sheets("Sheet1").AutoFilter.Range.Offset(1)).Copy Sheets("Sheet2").Range("A1")
 End Sub

 Sub Sample7()
    'オートフィルターで抽出されたデータを削除
    Dim myR As Range
    Set myR = Intersect(Sheets("Sheet1").AutoFilter.Range, Sheets("Sheet1").AutoFilter.Range.Offset(1))
    If Not myR Is Nothing Then myR.EntireRow.Delete
 End Sub

 (ぶらっと)

 おまけのおまけ

 上で、「抽出されたもの」に対する処理部品をアップしたけど、「抽出されなかったもの」に対しては
・抽出条件が ○○○ だとして、「○○○じゃないもの」を抽出条件にして上でアップした部品を使う。
・あるいは、以下のように、抽出されていないとうことを判定して処理する。

 Sub Sample8()
    'オートフィルターで抽出されていない行を判定する
    Dim c As Range
    For Each c In Sheets("Sheet1").AutoFilter.Range.Columns(1).Cells
        If Intersect(c, Sheets("Sheet1").AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible)) Is Nothing Then
            MsgBox c.Row & "行目は抽出されていません"
        End If
    Next
 End Sub

 (ぶらっと)

 ぶらっと様

 ぶらっと様が師匠に思えてきました。本当にありがとうございます。

 頂いた参考部品で私なりにコード作成しました。

    Sub 完了転記()

    Sheets("総体").Range("A1").AutoFilter field:=4, Criteria1:="<>"

    Intersect(Sheets("総体").AutoFilter.Range, Sheets("総体"). _
    AutoFilter.Range.Offset(1)).Copy Sheets("完了").Range("A3")

    Sheets("総体").Select
    Dim myR As Range
    Set myR = Intersect(Sheets("DB").AutoFilter.Range, Sheets("DB"). _
    AutoFilter.Range.Offset(1))
    If Not myR Is Nothing Then myR.EntireRow.Delete

    Sheets("総体").Range("A1").AutoFilter

 End Sub

 「総体」シートでの動作は問題ありませんが、「完了」シートに転記する際に
 データを既存データの1番下からどんどん追加させたいのです。

 Intersect(Sheets("総体").AutoFilter.Range, Sheets("総体"). _
    AutoFilter.Range.Offset(1)).Copy Sheets("完了").Range("A3")

 の Range("A3")を最終行とすれば良いのだと思うのですが、方法がわかりません。
 それとも他の方法があるのでしょうか?

 宜しくお願い致します。

 りんご


 Sheets("完了").Range("A3")

 これを

 Sheets("完了").Range("A" & Sheets("完了").Rows.Count).End(xlUp).Offset(1)

 Sheets("完了") のシート修飾が見た目煩雑なので、以下でも、

 Sub SampleA()
    Dim sh As Worksheet
    Set sh = Sheets("完了")
    Intersect(Sheets("総体").AutoFilter.Range, Sheets("総体").AutoFilter.Range.Offset(1)).Copy _
                                                    sh.Range("A" & sh.Rows.Count).End(xlUp).Offset(1)
    Set sh = Nothing
 End Sub

 Sub SampleB()
    With Sheets("完了")
        Intersect(Sheets("総体").AutoFilter.Range, Sheets("総体"). _
            AutoFilter.Range.Offset(1)).Copy .Range("A" & .Rows.Count).End(xlUp).Offset(1)
    End With
 End Sub

 (ぶらっと)

 ぶらっと様

 おはようございます。
 上手く出来ました。色々と本当にありがとうございました。

 りんご

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.