[[20170105231232]]　『発送日が今日の行だけを選択→コピーまで』（スッカラ）　ページの最後に飛ぶ

『発送日が今日の行だけを選択→コピーまで』（スッカラ）

   A　　　B　　　C　　　　D　　　E
 注文日		モノ	発送日	担当
 1月5日		モノA	1月5日	Aさん　　*
 1月5日		モノA	1月4日	Bさん
 1月5日		モノB	1月4日	Cさん
 1月5日		モノB	1月5日	Aさん　　*
 1月5日		モノA	1月6日	Bさん
 1月5日		モノA	1月5日	Cさん　　*
 1月5日		モノA	1月6日	Aさん
 1月5日		モノA	1月7日	Bさん
 1月5日		モノC	1月7日	Cさん

 以上のような表があったとすればD列が1月5日のA2：E2とA5：E5とA7：E7
 この3行を選択→コピーまでの方法などございますか？
 *マークは無視してください。
 B列はほぼほぼ空白セルになります。

 日付フィルター今日で範囲選択のちコピーでもいいのですが、
 1日に何度もするので どうにかそれより簡単にできないものかと思っています。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 こんばんわ。

 今日でフィルタリングするなら、1日1回で良いのでは？

 日付フィルター今日の操作自体が充分簡単な作業と思うんですが、
 それより簡単となると、、、マクロでボタンをクリックで指定の場所にコピペまでさせる
 くらいになるんじゃないかと思うのですが？

 マクロでするならフィルターオプション(オートフィルターでも良いですけど)で抽出して、
 コピペの操作をマクロ記録を取って、貼り付け位置だけ可変にすれば良いです。
 出来たコードをボタンに登録すれば完成です。

 後一応数式でG～L列に今日のデータだけを抽出する式です。
 元データ範囲は100行目までにしてるので、必要に応じて拡張して下さい。
 但し配列を扱ってるので範囲を広くし過ぎたら重くなります。
 関数なので当然ですが抽出されたデータのコピペは手動操作になります。

 G2 =IFERROR(INDEX(A:A,$L2),"")
 H列はなし
 I2 =IFERROR(INDEX(C:C,$L2),"")
 J2 =IFERROR(INDEX(D:D,$L2),"")
 K2 =IFERROR(INDEX(E:E,$L2),"")
 L2 =AGGREGATE(15,6,1/(D$1:D$100=TODAY())*ROW($1:$100),ROW(A1))
 それぞれ下に必要数オートフィル

（ sy） 2017/01/06(金) 00:04

 こんばんは

 Sub test()

   Dim i As Long, n As Long
   n = 2
      For i = 1 To Cells(Rows.Count, "d").End(xlUp).Row
      If Cells(i, "d").Value = Date Then
         n = n + 1
         '抽出先（H：M列に）今日のデータだけを抽出・・・変更して下さい。
         Cells(n, 8).Resize(1, 6).Value = Cells(i, 1).Resize(1, 6).Value

      End If
   Next
 End Sub
（万年主任） 2017/01/06(金) 00:29

 To 万年主任さん

 今の位置に n = n + 1 が記述されていたら、結果は3行目から転記されますよ。
 転記後に記述するか、もしくは初めの n = 2 を n = 1 にしないといけません。

 そもそも転記先は2行目からで良いのか質問文からは分からないので、

   n = Range("K1").CurrentRegion.Rows.Count

や

   n = Range("K" & Rows.Count).End(xlUp).Row

 と実行時にスタート位置を取得した方が良いと思います。

（ sy） 2017/01/07(土) 12:37

 ボタンにマクロを登録して、クリック処理ということであれば　syさん指摘のフィルターオプションが適していると思います。

 Sub Test()
    Dim shT As Worksheet
    Set shT = Sheets("Sheet2")  '★抽出シート
    shT.Cells.ClearContents
    With Sheets("Sheet1")       '★元シート
        With .Range("A1", .UsedRange)
            .Cells(1, .Columns.Count + 2).Value = .Range("D1").Value
            .Cells(2, .Columns.Count + 2).Value = Date
            .AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=.Cells(1, .Columns.Count + 2).Resize(2), CopyToRange:=shT.Range("A1")
            .Cells(1, .Columns.Count + 2).Resize(2).ClearContents
        End With
    End With
 End Sub

（β） 2017/01/07(土) 13:04

＞1日に何度もする

というのが、よくわからないのですが

＞この3行を選択→コピーまで

のほうがよいなら
手操作でしている日付フィルターを、マクロにするとこんな感じ

ただ、ゆっくりしても３０秒もかからない簡単な作業なので
操作履歴がクリアされるデメリットのほうが大きいような気がします。

 Sub test()

    With Range("A1").CurrentRegion.Resize(, 5)
        .AutoFilter
        .AutoFilter Field:=4, Criteria1:=xlFilterToday, Operator:=xlFilterDynamic
        If .Columns("A").SpecialCells(xlCellTypeVisible).Count > 1 Then
            Intersect(.Cells, .Offset(1)).Copy
        End If
    End With

 End Sub

（マナ） 2017/01/07(土) 14:00

＞日付フィルター今日で範囲選択のちコピーでもいいのですが、
＞ 1日に何度もするのでどうにかそれより簡単にできないものかと思っています。
別シートにピボットテーブルを挿入し
モノ、発送日、担当
を行ラベルに設定して、
今日で、フィルターを掛けてはいかがでしょうか？
更新ボタン押下で最新の状態に更新できると思います。

その時にデータの追加があってもいいように、
テーブルの範囲を可変で得られるように名前の定義をします。
http://d.hatena.ne.jp/Shunmin365/20120312/1331559364

（まっつわん） 2017/01/07(土) 15:48

 アップしたコード、フィルターオプションの条件欄をマクロ内で生成し、処理後にクリアしていますが、
 もし、元シート上に条件欄を、あらかじめ作成しておけば、コードはシンプルになります。

 元シートの、たとえば H1 に　発送日、H2 に =TODAY() といれておいてください。

 Sub Test2()
    Dim shT As Worksheet
    Set shT = Sheets("Sheet2")  '★抽出シート
    shT.Cells.ClearContents
    With Sheets("Sheet1")       '★元シート
        .Range("A1", .UsedRange).Columns("A:E").AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=.Range("H1:H2"), CopyToRange:=shT.Range("A1")
    End With
 End Sub

（β） 2017/01/08(日) 09:38

ありがとうございます！

ただマクロもピボットテーブルもやったことがなくて
（簡単にできないものかと言っておきながらアレですけど．．．すみません。）

とりあえずコードを貼りますね。お世話になりました。

（スッカラ） 2017/01/08(日) 18:59

コメント返信：

[ 一覧(最新更新順) ]

[[20170105231232]] 『発送日が今日の行だけを選択→コピーまで』（スッカラ） ページの最後に飛ぶ

[[20170105231232]]　『発送日が今日の行だけを選択→コピーまで』（スッカラ）　ページの最後に飛ぶ